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

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

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

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

HGCommand subclass:#log
	instanceVariableNames:'start stop'
	classVariableNames:''
	poolDictionaries:''
	privateIn:HGCommand
!

HGCommand subclass:#push
	instanceVariableNames:'remote refspec'
	classVariableNames:''
	poolDictionaries:''
	privateIn:HGCommand
!

HGCommand subclass:#status
	instanceVariableNames:'path'
	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'!

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

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

log
    ^log new

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

push
    ^push new

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

status
    ^status new

    "Created: / 23-10-2012 / 11:10:13 / 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 |

    pipe := NonPositionableExternalStream makePipe.
    output := pipe first.
    environment := OperatingSystem getEnvironment copy.

    environment at:'LANG' put:'C'.
    sema := Semaphore new name: 'Waiting for hg command to finish'.
    Processor monitor:[
        pid := OperatingSystem exec:(self executable) withArguments:(self arguments)
            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.
    status success ifFalse:[
        HGCommandError raiseErrorString: ('hg command failed (status %1)' expandMacrosWith: status code) .
    ].
    ^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 / 20:01:25 / 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 shouldImplement

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

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

    HGExecutable notNil ifTrue:[^ HGExecutable].

    OperatingSystem isMSWINDOWSlike ifTrue:[
"/        h := Win32OperatingSystem registryEntry 
"/                key:'HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\App Paths\svn.exe'.
"/        h notNil ifTrue:[GitExecutable := h valueNamed:''].
"/        GitExecutable notEmptyOrNil ifTrue:[^ GitExecutable]
        HGExecutable := OperatingSystem pathOfCommand:'hg'.
        ^HGExecutable
    ].

    OperatingSystem isUNIXlike ifTrue:[
        HGExecutable := OperatingSystem pathOfCommand:'hg'.    
        ^HGExecutable
    ].

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


    "
     GitExecutable := nil.
     self basicNew executable
    "

    "Created: / 11-05-2011 / 07:59:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 09-12-2011 / 22:48:33 / dundee"
    "Modified (format): / 27-12-2011 / 15:51:06 / dundee"
    "Modified: / 17-10-2012 / 13:11:59 / 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>"
! !

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

    stream nextPut: url; nextPut: path

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

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

    ^ ''

    "Modified: / 01-10-2012 / 00:11:24 / 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 |

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

    "Created: / 12-11-2012 / 22:38:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 14-11-2012 / 19:45:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parse:stream
    "superclass GitCommand 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>"
! !

!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::push methodsFor:'accessing'!

refspec
    ^ refspec
!

refspec:something
    refspec := something.
!

remote
    ^ remote
!

remote:something
    remote := something.
! !

!HGCommand::push methodsFor:'private'!

argumentsCommandOn:stream
    "Called to get command specific options"

    stream nextPut: remote.
    refspec notNil ifTrue:[
        stream nextPut: refspec.
    ]

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

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

    ^ ''

    "Modified: / 01-10-2012 / 00:11:29 / 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 class methodsFor:'documentation'!

version_SVN
    ^ '$Id::                                                                                                                        $'
! !

HGCommand initialize!