mercurial/HGCommand.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Wed, 21 Nov 2012 01:21:47 +0000
changeset 88 1ad71a063a20
parent 82 40eb86d8d5bd
child 95 83ee62dc9491
permissions -rw-r--r--
Bunch of fixes. HGPackageModel: fixed temporary working copy creation. Must update temporary working copy to a revision the package in image is based on. HGStatus & HGCommandParser: added new status (Copied), fixed command parser to correctly parse copied file status. Added HGRevisionInfo class as interface to AbstractSourceCodeManager. HGRepository & HGWorkingCopy: improved cloning and updating.

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

Object subclass:#HGCommand
	instanceVariableNames:'workingDirectory'
	classVariableNames:'HGExecutable HGVersion Debugging'
	poolDictionaries:''
	category:'SCM-Mercurial-Internal'
!

HGCommand subclass:#add
	instanceVariableNames:'paths'
	classVariableNames:''
	poolDictionaries:''
	privateIn:HGCommand
!

HGCommand subclass:#cat
	instanceVariableNames:'path revision'
	classVariableNames:''
	poolDictionaries:''
	privateIn:HGCommand
!

HGCommand subclass:#clone
	instanceVariableNames:'url path update'
	classVariableNames:''
	poolDictionaries:''
	privateIn:HGCommand
!

HGCommand subclass:#commit
	instanceVariableNames:'message files'
	classVariableNames:''
	poolDictionaries:''
	privateIn:HGCommand
!

HGCommand subclass:#locate
	instanceVariableNames:'revision'
	classVariableNames:''
	poolDictionaries:''
	privateIn:HGCommand
!

HGCommand subclass:#log
	instanceVariableNames:'start stop'
	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'
	classVariableNames:''
	poolDictionaries:''
	privateIn:HGCommand
!

HGCommand subclass:#remove
	instanceVariableNames:'paths'
	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:''
	classVariableNames:''
	poolDictionaries:''
	privateIn:HGCommand
!

!HGCommand class methodsFor:'documentation'!

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:'initialization'!

initialize
    "Invoked at system start or when the class is dynamically loaded."

    "/ please change as required (and remove this comment)

    "/ HGExecutable := nil.
    Debugging := OperatingSystem getLoginName = 'jv'.

    "Modified: / 12-11-2012 / 22:42:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!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

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

hgVersion
    "Return mercurial version installed on this compiter"
    
    HGVersion isNil ifTrue:[
        HGVersion := version new execute
    ].
    ^ HGVersion

    "
     HGCommand mercurialVersion"
    "Created: / 19-11-2012 / 20:14:53 / 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>"
!

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

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

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

mv
    ^mv new

    "Created: / 15-11-2012 / 00:22:16 / 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>"
!

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

!HGCommand methodsFor:'accessing'!

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

!HGCommand methodsFor:'executing'!

execute
    | pipe output pid environment sema status retval args |

    pipe := NonPositionableExternalStream makePipe.
    output := pipe first.

    OperatingSystem isUNIXlike ifTrue:[
        environment := OperatingSystem getEnvironment copy.
    ] ifFalse:[
        environment := Dictionary new.
    ].
    environment at:'LANG' put:'C'.

    args := self arguments.
    OperatingSystem isMSWINDOWSlike ifTrue:[
        args := String streamContents:[:s|
            args 
                do:[:each | s nextPut:$"; nextPutAll: each; nextPut: $"]
                separatedBy: [ s space ]
        ]
    ].

    sema := Semaphore new name: 'Waiting for hg command to finish'.
    Processor monitor:[
        pid := OperatingSystem exec:(self executable) withArguments:args
            environment:environment
            fileDescriptors:{0 . pipe second fileDescriptor . pipe second fileDescriptor}
            fork:true 
            newPgrp:false 
            inDirectory:self workingDirectory
    ] action:[:stat |
        status := stat.
        sema signal.
    ].
    

    pipe second close.
    pid isNil ifTrue:[
        HGCommandError raiseErrorString: 'cannot execute hg command'.
        output close.
        ^ self.
    ].
    Debugging ifTrue:[
        output := output contents asString readStream
    ].
    retval := self parse: output.
    sema wait.
    ^self status: status result: retval

    "
        SVNv2::Command info: 'https://swing.fit.cvut.cz/svn/stx/libsvn'
    "

    "Created: / 11-05-2011 / 07:45:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 17-12-2011 / 19:22:00 / dundee"
    "Modified (format): / 27-12-2011 / 15:53:54 / dundee"
    "Modified: / 14-11-2012 / 13:41:57 / jv"
    "Modified: / 15-11-2012 / 17:04:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGCommand methodsFor:'private'!

arguments

    ^ OrderedCollection streamContents:[:s |
        s nextPut:self executable.
        self argumentsGlobalOn:s.
        s nextPut:self command.
        self argumentsCommandOn:s.
    ].

    "Created: / 11-05-2011 / 07:58:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (format): / 27-12-2011 / 15:47:23 / dundee"
!

argumentsCommandOn:stream
    "Called to get command specific options"

    self subclassResponsibility

    "Created: / 11-05-2011 / 07:58:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (format): / 27-12-2011 / 15:46:59 / dundee"
    "Modified: / 16-11-2012 / 22:31:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

argumentsGlobalOn:arg
    "Called to get global options"

    "Created: / 11-05-2011 / 07:58:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (format): / 27-12-2011 / 15:47:10 / dundee"
    "Modified: / 30-09-2012 / 23:43:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

command
    "Returns the git 'command' option, i.e. commit,
     push, pull, ..."

    ^self class nameWithoutPrefix

    "
        HGCommand::push basicNew command
    "

    "Created: / 11-05-2011 / 07:58:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (format): / 27-12-2011 / 15:47:17 / dundee"
    "Modified: / 30-09-2012 / 23:37:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (comment): / 17-10-2012 / 13:25:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

executable
    ^ self class hgCommand

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

parse: stream
    "Parses output of 'hg' command, i.e. commit, log, update, checkout, 
     etc."

    ^ self subclassResponsibility

    "Created: / 11-05-2011 / 07:58:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Created: / 17-12-2011 / 17:02:41 / dundee"
    "Modified (comment): / 17-10-2012 / 13:14:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

status: status result: result
    "Called when hg command finishes, passing it's status and result from parser"

    status success ifFalse:[
        HGCommandError raiseErrorString: ('hg command failed (status %1)' expandMacrosWith: status code) .
    ].
    ^result

    "Created: / 15-11-2012 / 17:04:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGCommand::add methodsFor:'accessing'!

paths
    ^ paths
!

paths:something
    paths := something.
! !

!HGCommand::add methodsFor:'private'!

argumentsCommandOn:stream
    "Called to get command specific options"

    paths isEmptyOrNil ifTrue:[
        self error: 'No paths given'
    ].
    stream nextPutAll: paths

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

parse:stream
    "Parses output of 'hg' command, i.e. commit, log, update, checkout, 
     etc."

    ^ nil

    "Modified: / 15-11-2012 / 00:38:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGCommand::cat methodsFor:'accessing'!

path
    ^ path
!

path:something
    path := something.
!

revision
    ^ revision
!

revision:something
    revision := something.
! !

!HGCommand::cat methodsFor:'executing'!

execute
    "
    A hacked version of #execute that returns a open read
    stream to read directly from 'hg cat' stdout...
    
    "

    | pipe output pid environment sema args |

    pipe := NonPositionableExternalStream makePipe.
    output := pipe first.

    OperatingSystem isUNIXlike ifTrue:[
        environment := OperatingSystem getEnvironment copy.
    ] ifFalse:[
        environment := Dictionary new.
    ].
    environment at:'LANG' put:'C'.

    args := self arguments.
    OperatingSystem isMSWINDOWSlike ifTrue:[
        args := String streamContents:[:s|
            args 
                do:[:each | s nextPut:$"; nextPutAll: each; nextPut: $"]
                separatedBy: [ s space ]
        ]
    ].

    sema := Semaphore new name: 'Waiting for hg command to finish'.
    pid := OperatingSystem exec:(self executable) withArguments:args
            environment:environment
            fileDescriptors:{0 . pipe second fileDescriptor . pipe second fileDescriptor}
            fork:true 
            newPgrp:false 
            inDirectory:self workingDirectory.
    pipe second close.
    pid isNil ifTrue:[
        HGCommandError raiseErrorString: 'cannot execute hg command'.
        output close.
        ^ self.
    ].
    ^output

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

!HGCommand::cat methodsFor:'private'!

argumentsCommandOn:stream
    "Called to get command specific options"

    path isNil ifTrue:[
        self error:'No path specified'
    ].
    revision isNil ifTrue:[
        self error:'No revision specified'
    ].
    stream nextPut:'--rev'; nextPut: revision asString.
    stream nextPut:path

    "Modified: / 17-11-2012 / 00:09:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parse:stream
    "Parses output of 'hg' command, i.e. commit, log, update, checkout, 
     etc."

    ^ self shouldImplement
! !

!HGCommand::clone methodsFor:'accessing'!

path
    ^ path
!

path:something
    path := something.
!

url
    ^ url
!

url:something
    url := something.
! !

!HGCommand::clone methodsFor:'private'!

argumentsCommandOn:stream
    "Called to get command specific options"
    update == false ifTrue:[
        stream nextPut:'--noupdate'.
    ].
    stream nextPut: url; nextPut: path.

    "Created: / 01-10-2012 / 00:04:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 21-11-2012 / 00:17:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parse:stream
    "superclass Command says that I am responsible to implement this method"

    ^ nil

    "Modified: / 14-11-2012 / 22:42:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGCommand::commit methodsFor:'accessing'!

files
    ^ files
!

files:something
    files := something.
!

message
    ^ message
!

message:something
    message := something.
! !

!HGCommand::commit methodsFor:'private'!

argumentsCommandOn:stream
    "Called to get command specific options"

    | author |
    author := HGAuthorQuery query.
    author notNil ifTrue:[
        stream nextPut:'--user'; nextPut: author
    ].
    stream nextPut:'-m'; nextPut: message.
    files notNil ifTrue:[
        stream nextPutAll: files
    ].

    "Created: / 12-11-2012 / 22:38:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 17-11-2012 / 00:59:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parse:stream
    "superclass HGCommand says that I am responsible to implement this method"

    "Nothing to do"

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

status: status result: result
    "Called when hg command finishes, passing it's status and result from parser"

    (status code ~~ 0 and:[status code ~~ 1]) ifTrue:[
        HGCommandError raiseErrorString: ('hg command failed (status %1)' expandMacrosWith: status code) .
    ].
    ^result

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

!HGCommand::locate methodsFor:'accessing'!

revision
    ^ revision
!

revision:rev
    revision := rev.
! !

!HGCommand::locate methodsFor:'private'!

argumentsCommandOn:stream
    "Called to get command specific options"

    stream nextPut:'--print0'.
    revision notNil ifTrue:[
        stream nextPut: '--rev'; nextPut: revision printString.
    ].

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

parse:stream
    "Parses output of 'hg' command, i.e. commit, log, update, checkout, 
     etc."

    ^ (HGCommandParser on: stream) parseCommandLocate

    "Modified: / 16-11-2012 / 22:33:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGCommand::log methodsFor:'accessing'!

start
    ^ start
!

start:something
    start := something.
!

stop
    ^ stop
!

stop:something
    stop := something.
! !

!HGCommand::log methodsFor:'private'!

argumentsCommandOn:stream
    "Called to get command specific options"

    stream nextPut:'--rev'.
    start isNil ifTrue:[
        self error:'No start revision given'.
    ].

    stop notNil ifTrue:[
        stream nextPut:(start printString , ':' , stop printString)
    ] ifFalse:[
        stream nextPut:start
    ].



    stream 
        nextPut:'--debug';
        nextPut:'--template';
        nextPut:HGCommandParser templateLog.

    "Created: / 13-11-2012 / 09:05:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 13-11-2012 / 17:15:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parse: stream
    "Parses output of 'hg' command, i.e. commit, log, update, checkout, 
     etc."

    ^ (HGCommandParser on: stream) parseCommandLog

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

!HGCommand::mv methodsFor:'accessing'!

destination
    ^ destination
!

destination:something
    destination := something.
!

source
    ^ source
!

source:something
    source := something.
! !

!HGCommand::mv methodsFor:'private'!

argumentsCommandOn:stream
    "Called to get command specific options"

    source isNil ifTrue:[
        self error:'No source'
    ].
    source asFilename exists ifFalse:[
        self error:('(Source does not exist (%1)' bindWith: source)
    ].
    destination isNil ifTrue:[
        self error:'No destination'
    ].
    stream nextPut: source asString; nextPut: destination.

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

parse:stream
    "Parses output of 'hg' command, i.e. commit, log, update, checkout, 
     etc."

    ^ nil

    "Modified: / 15-11-2012 / 00:38:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGCommand::pull methodsFor:'private'!

argumentsCommandOn:stream
    "Called to get command specific options"

    url notNil ifTrue:[
        stream nextPut: url.
    ].

    "Created: / 30-09-2012 / 23:44:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 15-11-2012 / 09:56:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parse:stream
    "superclass HGCommand says that I am responsible to implement this method"

    ^ nil

    "Modified: / 15-11-2012 / 09:53:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGCommand::push methodsFor:'private'!

argumentsCommandOn:stream
    "Called to get command specific options"

    url notNil ifTrue:[
        stream nextPut: url.
    ].

    "Created: / 30-09-2012 / 23:44:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 15-11-2012 / 09:56:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parse:stream
    "superclass HGCommand says that I am responsible to implement this method"

    ^ nil

    "Modified: / 15-11-2012 / 09:53:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

status: status result: result
    "Called when hg command finishes, passing it's status and result from parser"

    (status code ~~ 0 and:[status code ~~ 1]) ifTrue:[
        HGCommandError raiseErrorString: ('hg command failed (status %1)' expandMacrosWith: status code) .
    ].
    ^result

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

!HGCommand::remove methodsFor:'accessing'!

paths
    ^ paths
!

paths:something
    paths := something.
! !

!HGCommand::remove methodsFor:'private'!

argumentsCommandOn:stream
    "Called to get command specific options"

    paths isEmptyOrNil ifTrue:[
        self error: 'No paths given'
    ].
    stream nextPutAll: paths

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

parse:stream
    "Parses output of 'hg' command, i.e. commit, log, update, checkout, 
     etc."

    ^ nil

    "Modified: / 15-11-2012 / 00:38:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGCommand::status methodsFor:'accessing'!

path
    ^ path
!

path:aString
    path := aString.
! !

!HGCommand::status methodsFor:'private'!

argumentsCommandOn:stream
    "Called to get command specific options"

    stream nextPut:'-A'.
    path notNil ifTrue:[stream nextPut: path]

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

parse:stream
    ^(HGCommandParser on: stream) parseCommandStatus

    "Modified: / 23-10-2012 / 11:07:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGCommand::update methodsFor:'accessing'!

revision
    ^ revision
!

revision:something
    revision := something.
! !

!HGCommand::update methodsFor:'executing'!

execute
    "
    A hacked version of #execute that returns a open read
    stream to read directly from 'hg cat' stdout...
    
    "

    | pipe output pid environment sema args |

    pipe := NonPositionableExternalStream makePipe.
    output := pipe first.

    OperatingSystem isUNIXlike ifTrue:[
        environment := OperatingSystem getEnvironment copy.
    ] ifFalse:[
        environment := Dictionary new.
    ].
    environment at:'LANG' put:'C'.

    args := self arguments.
    OperatingSystem isMSWINDOWSlike ifTrue:[
        args := String streamContents:[:s|
            args 
                do:[:each | s nextPut:$"; nextPutAll: each; nextPut: $"]
                separatedBy: [ s space ]
        ]
    ].

    sema := Semaphore new name: 'Waiting for hg command to finish'.
    pid := OperatingSystem exec:(self executable) withArguments:args
            environment:environment
            fileDescriptors:{0 . pipe second fileDescriptor . pipe second fileDescriptor}
            fork:true 
            newPgrp:false 
            inDirectory:self workingDirectory.
    pipe second close.
    pid isNil ifTrue:[
        HGCommandError raiseErrorString: 'cannot execute hg command'.
        output close.
        ^ self.
    ].
    ^output

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

!HGCommand::update methodsFor:'private'!

argumentsCommandOn:stream
    "Called to get command specific options"

    revision isNil ifTrue:[
        stream nextPut:'--rev'; nextPut: revision asString.
    ].

    "Modified: / 21-11-2012 / 00:18:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parse:stream
    "Parses output of 'hg' command, i.e. commit, log, update, checkout, 
     etc."

    ^ nil

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

!HGCommand::version methodsFor:'private'!

arguments

    ^ Array with: HGExecutable with: '--version'

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

parse: stream
    "Parses output of 'hg' command, i.e. commit, log, update, checkout, 
     etc."

    ^(HGCommandParser on: stream) parseCommandVersion

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

!HGCommand class methodsFor:'documentation'!

version_HG
    "Never, ever change this method. Ask JV or CG why"
    ^thisContext method mclass theNonMetaclass instVarNamed: #revision
!

version_SVN
    ^ '§Id::                                                                                                                        §'
! !

HGCommand initialize!