Command server is now used by default.
All HGTests exept 2 passes. Further invesitgation on those two is
required.
"
COPYRIGHT (c) 2012-2013 by Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libscm/mercurial' }"
Object subclass:#HGCommand
instanceVariableNames:'workingDirectory result error errors blocker errorReader
outputReader'
classVariableNames:'HGExecutable HGVersion Debugging Tracing'
poolDictionaries:''
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:#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:'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
"
COPYRIGHT (c) 2012-2013 by Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
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 := Tracing := OperatingSystem getLoginName = 'jv'.
"Modified: / 29-01-2013 / 16:22:48 / 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
"
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>"
!
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>"
! !
!HGCommand methodsFor:'accessing'!
repository: anHGRepository
workingDirectory isNil ifTrue:[
workingDirectory := anHGRepository pathName
].
"Created: / 03-03-2013 / 23:10:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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>"
! !
!HGCommand methodsFor:'accessing-internal'!
blocker
^ blocker
!
errorReader
^ errorReader
!
errors
^ errors
!
outputReader
^ outputReader
! !
!HGCommand methodsFor:'error reporting'!
propagate: anException
"Propagates the error to the process that invoked #execute.
Used by sub-processes to signal errors to the caller"
self assert: anException isException.
Tracing ifTrue:[
Logger log: 'propagating: ' , anException description severity: #trace facility: 'HG'.
].
errors nextPut: anException.
"Created: / 04-02-2013 / 21:29:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
signal
"Signal all propagated exceptions to the caller"
| ex |
[ (ex := errors nextOrNil) notNil ] whileTrue:[
Tracing ifTrue:[
Logger log: 'signalling: ' , ex description severity: #trace facility: 'HG'.
].
ex raiseRequest
].
"Created: / 04-02-2013 / 21:33:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGCommand methodsFor:'executing'!
execute
| stdoutPipe stdout stderrPipe stderr pid environment status args spin |
self initialize.
stdoutPipe := NonPositionableExternalStream makePipe.
stdout := stdoutPipe first.
stderrPipe := NonPositionableExternalStream makePipe.
stderr := stderrPipe first.
environment := OperatingSystem isUNIXlike
ifTrue:[OperatingSystem getEnvironment copy]
ifFalse:[environment := Dictionary new].
environment at: 'HGEDITOR' put: 'true'.
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 ]
]
].
Processor monitor:[
Tracing ifTrue:[
Logger log: 'cmd: executing: ' , (args isString ifTrue:[args] ifFalse:[args asStringWith:' ']) severity: #trace facility: 'HG'.
].
pid := OperatingSystem exec:(self executable) withArguments:args
environment:environment
fileDescriptors:{0 . stdoutPipe second fileDescriptor . stderrPipe second fileDescriptor}
fork:true
newPgrp:false
inDirectory:self workingDirectory
] action:[:stat |
Tracing ifTrue:[
Logger log: 'cmd: command finished' severity: #trace facility: 'HG'.
].
status := stat.
blocker signal.
].
stdoutPipe second close.
stderrPipe second close.
pid isNil ifTrue:[
HGCommandError raiseErrorString: 'cannot execute hg command'.
stdout close.
^ self.
].
(Debugging and:[OperatingSystem isUNIXlike]) ifTrue:[
stdout := stdout contents asString readStream.
stderr := stderr contents asString readStream.
].
self spawnErrorReaderOn: stderr.
self spawnOutputReaderOn: stdout.
spin := SemaphoreSet with: blocker with: errors readSemaphore.
[
[ spin wait ~~ blocker ] whileTrue:[ self signal ]
] ensure:[
stderr close.
stdout close.
].
self signal.
Tracing ifTrue:[
Logger log: 'returning' severity: #trace facility: 'HG'.
].
^self status: status result: result
"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: / 03-03-2013 / 19:50:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
executeOnRepository: anHGRepository
workingDirectory isNil ifTrue:[
workingDirectory := anHGRepository pathName
].
^self execute.
"Created: / 03-03-2013 / 20:34:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGCommand methodsFor:'initialization'!
initialize
"Invoked when a new instance is created."
"/ please change as required (and remove this comment)
"/ workingDirectory := nil.
"/ result := nil.
"/ error := nil.
"/ workers := nil.
"/ errors := nil.
errors := SharedQueue new.
blocker := (Semaphore new:-2) name: 'Waiting for hg command to finish'.
"/ super initialize. -- commented since inherited method does nothing
"Modified: / 03-03-2013 / 19:50:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGCommand methodsFor:'private'!
arguments
^ OrderedCollection streamContents:[:s |
s nextPut: self executable.
s nextPut: '--noninteractive'.
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"
"Modified: / 16-12-2012 / 00:26:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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>"
!
parseError:stream
"Parses output of 'hg' command, i.e. commit, log, update, checkout,
etc."
^ (self parserOn: stream) parseError.
"Created: / 04-02-2013 / 11:59:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseOutput: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>"
!
parserOn: aStream
"Returns an HGCommandParser initialized on given stream."
^HGCommandParser for: self on: aStream
"Created: / 04-02-2013 / 12:17:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-02-2013 / 14:14:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
spawn:block name: name
"Spawn a new background thread executing given block"
| worker |
worker := [ block on: Error do:[:ex|self propagate:ex] ] newProcess.
worker addExitAction:[
Tracing ifTrue:[
Logger log: 'cmd: worker ''', name , ''' finished' severity: #trace facility: 'HG'.
].
blocker notNil ifTrue:[blocker signal].
].
worker resume.
worker name: name.
^worker
"Created: / 03-03-2013 / 16:56:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 03-03-2013 / 19:12:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
spawnErrorReaderOn: stderr
errorReader isNil ifTrue:[
errorReader := self spawn: [ self parseError: stderr ] name: 'Error reader'
].
"Created: / 03-03-2013 / 16:59:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
spawnOutputReaderOn: stdout
outputReader isNil ifTrue:[
outputReader := self spawn: [ result := self parseOutput: stdout ] name: 'Output reader'.
]
"Created: / 03-03-2013 / 17:00:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
status: status result: res
"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) .
].
^res
"Created: / 15-11-2012 / 17:04:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 04-02-2013 / 12:12:08 / 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>"
!
parseOutput: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::branches methodsFor:'accessing'!
active
^ active
!
active:aBoolean
active := aBoolean.
!
closed
^ closed
!
closed:aBoolean
closed := aBoolean.
! !
!HGCommand::branches methodsFor:'private'!
argumentsCommandOn:stream
"Called to get command specific options"
active == true ifTrue:[
stream nextPut:'--active'
].
closed == true ifTrue:[
stream nextPut:'--closed'
].
"Created: / 27-11-2012 / 19:54:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
argumentsGlobalOn:stream
stream nextPut:'--debug' "/to get full node ids
"Created: / 27-11-2012 / 19:54:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseError:stream
^ (self parserOn: stream) parseErrorBranches.
"Created: / 06-02-2013 / 19:20:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseOutput:stream
"Parses output of 'hg' command, i.e. commit, log, update, checkout,
etc."
^ (self parserOn:stream) parseCommandBranches
"Created: / 27-11-2012 / 19:55:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGCommand::cat methodsFor:'accessing'!
destination
^ destination
!
destination:aStringOrFilename
destination := aStringOrFilename.
!
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 sout exec |
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 ]
]
].
sout := destination notNil
ifTrue:[destination asFilename writeStream]
ifFalse:[pipe second].
sema := Semaphore new name: 'Waiting for hg command to finish'.
exec := [
pid := OperatingSystem exec:(self executable) withArguments:args
environment:environment
fileDescriptors:{0 . sout fileDescriptor . pipe second fileDescriptor}
fork:true
newPgrp:false
inDirectory:self workingDirectory.
].
destination notNil ifTrue:[
Processor
monitor:exec
action:[:stat |
sema signal.
].
] ifFalse:[
exec value
].
pipe second close.
sout close.
pid isNil ifTrue:[
HGCommandError raiseErrorString: 'cannot execute hg command'.
output close.
^ self.
].
^destination notNil
ifTrue:[sema wait. nil]
ifFalse:[output].
"Created: / 17-11-2012 / 00:13:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-12-2012 / 10:10:57 / 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>"
!
parseOutput: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>"
!
parseOutput: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'!
author
^ author
!
author:aString
author := aString.
!
date
^ date
!
date:aTimestampOrString
date := aTimestampOrString.
!
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 notNil ifTrue:[
stream nextPut:'--user'; nextPut: author
].
date notNil ifTrue:[
stream nextPut:'--date'.
date isTimestamp ifTrue:[
stream nextPut: (date printStringFormat: '%(year)-%(month)-%(day) %H:%m:%S')
] ifFalse:[
stream nextPut: date asString
]
].
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: / 07-12-2012 / 15:32:51 / jv"
"Modified: / 01-02-2013 / 14:49:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseError:stream
"Parses output of 'hg' command, i.e. commit, log, update, checkout,
etc."
^ (self parserOn: stream) parseErrorCommit.
"Created: / 04-02-2013 / 12:28:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseOutput: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::heads methodsFor:'private'!
argumentsCommandOn:stream
"Called to get command specific options"
stream
nextPut:'--template';
nextPut:HGCommandParser templateHeads.
"Created: / 27-11-2012 / 21:30:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseOutput:stream
"Parses output of 'hg' command, i.e. commit, log, update, checkout,
etc."
^ (self parserOn:stream) parseCommandHeads
"Created: / 27-11-2012 / 21:30:35 / 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-12-2012 / 00:09:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseOutput:stream
"Parses output of 'hg' command, i.e. commit, log, update, checkout,
etc."
^ (self parserOn:stream) parseCommandLocate
"Modified: / 16-11-2012 / 22:33:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGCommand::log methodsFor:'accessing'!
childrenOnly
^ childrenOnly
!
childrenOnly:aBoolean
childrenOnly := aBoolean.
!
path
^ path
!
path:aString
path := aString.
!
revset: revset
revsets isNil ifTrue:[revsets := OrderedCollection new].
revsets add: revset.
"Created: / 22-01-2013 / 16:16:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
revsets: aCollection
revsets isNil ifTrue:[
revsets := aCollection
] ifFalse:[
revsets addAll: aCollection
].
"Created: / 22-01-2013 / 16:21:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGCommand::log methodsFor:'private'!
argumentsCommandOn:stream
"Called to get command specific options"
| template |
path isNil ifTrue:[
revsets isEmptyOrNil ifTrue:[
self error:'No revisions given'.
].
revsets do:[:revset|
stream nextPut:'--rev'.
stream nextPut:revset asString
].
template := HGCommandParser templateLog.
] ifFalse:[
stream nextPut: '--follow'.
template := HGCommandParser templateLogFile.
].
childrenOnly == true ifTrue:[
template := HGCommandParser templateLogChildren.
].
stream
nextPut:'--debug';
nextPut:'--template';
nextPut:template.
path notNil ifTrue:[
stream nextPut: path.
].
"Created: / 13-11-2012 / 09:05:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 22-01-2013 / 16:16:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseOutput:stream
"Parses output of 'hg' command, i.e. commit, log, update, checkout,
etc."
childrenOnly == true ifTrue:[
^ (self parserOn:stream) parseCommandLogChildren.
].
^ path isNil
ifTrue:[ (self parserOn:stream) parseCommandLog ]
ifFalse:[ (self parserOn:stream) parseCommandLogFile ]
"Created: / 13-11-2012 / 09:05:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 05-12-2012 / 23:51:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGCommand::merge methodsFor:'accessing'!
revision
^ revision
!
revision:something
revision := something.
!
tool
^ tool
!
tool:aString
tool := aString.
! !
!HGCommand::merge methodsFor:'private'!
argumentsCommandOn:stream
"Called to get command specific options"
revision notNil ifTrue:[
stream nextPut:'--rev'; nextPut: revision asString.
].
revision notNil ifTrue:[
stream nextPut:'--tool'; nextPut: tool asString.
].
"Modified: / 14-01-2013 / 15:40:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseOutput:stream
"Parses output of 'hg' command, i.e. commit, log, update, checkout,
etc."
^ (self parserOn:stream) parseCommandMerge
"Modified: / 14-01-2013 / 16:00:40 / 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: / 14-01-2013 / 16:05:34 / 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>"
!
parseOutput: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:'accessing'!
url
^ url
!
url:aString
url := aString.
! !
!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>"
!
parseOutput:stream
"superclass HGCommand says that I am responsible to implement this method"
^ (self parserOn:stream) parseCommandPull
"Modified: / 04-02-2013 / 15:35:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGCommand::push methodsFor:'accessing'!
force
^ force
!
force:something
force := something.
!
url
^ url
!
url:remote
url := remote.
! !
!HGCommand::push methodsFor:'private'!
argumentsCommandOn:stream
"Called to get command specific options"
stream nextPut: (url ? 'default').
force == true ifTrue:[
stream nextPut:'--force'
]
"Created: / 30-09-2012 / 23:44:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 29-01-2013 / 15:42:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseError:stream
"Parses output of 'hg' command, i.e. commit, log, update, checkout,
etc."
^ (self parserOn: stream) parseErrorPush.
"Created: / 04-02-2013 / 12:53:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseOutput:stream
"superclass HGCommand says that I am responsible to implement this method"
^ (self parserOn:stream) parseCommandPush
"Modified: / 10-12-2012 / 02:15:25 / 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>"
!
parseOutput: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::resolve class methodsFor:'initialization'!
initialize
"Invoked at system start or when the class is dynamically loaded."
"/ please change as required (and remove this comment)
! !
!HGCommand::resolve methodsFor:'accessing'!
files
^ files
!
files:something
files := something.
!
mark
^ mark
!
mark:something
mark := something.
!
tool
^ tool
!
tool:something
tool := something.
!
unmark
^ unmark
!
unmark:something
unmark := something.
! !
!HGCommand::resolve methodsFor:'private'!
argumentsCommandOn:stream
"Called to get command specific options"
tool notNil ifTrue:[
stream nextPut:'--tool'; nextPut: tool
].
mark ifTrue:[
self assert: (unmark isNil or:[unmark not]).
stream nextPut: '--mark'.
].
unmark ifTrue:[
self assert: (mark isNil or:[mark not]).
stream nextPut: '--unmark'.
].
files do:[:f|stream nextPut: f].
"Modified: / 14-01-2013 / 19:29:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseOutput:stream
"Parses output of 'hg' command, i.e. commit, log, update, checkout,
etc."
^ nil
"Modified: / 14-01-2013 / 19:27:39 / 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 ifTrue:[ ^ true ].
status code == 1 ifTrue:[ ^ false].
HGCommandError raiseErrorString: ('hg command failed (status %1)' expandMacrosWith: status code).
^false
"Created: / 14-01-2013 / 19:27:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGCommand::resolve__list methodsFor:'private'!
argumentsCommandOn:stream
"Called to get command specific options"
stream nextPut: '--list'
"Modified: / 14-01-2013 / 16:43:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
command
^'resolve'
"Created: / 14-01-2013 / 16:50:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseOutput:stream
"Parses output of 'hg' command, i.e. commit, log, update, checkout,
etc."
^ (self parserOn:stream) parseCommandResolveList
"Modified: / 14-01-2013 / 16:43:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGCommand::showconfig methodsFor:'accessing'!
argumentsCommandOn:stream
"Called to get command specific options"
key notNil ifTrue:[
stream nextPut: key
].
"Created: / 06-12-2012 / 15:53:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseOutput:stream
"Parses output of 'hg' command, i.e. commit, log, update, checkout,
etc."
^ (self parserOn:stream) parseCommandShowConfig
"Created: / 06-12-2012 / 21:45:36 / 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>"
!
parseOutput:stream
^ (self parserOn: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:'private'!
argumentsCommandOn:stream
"Called to get command specific options"
revision notNil ifTrue:[
stream nextPut:'--rev'; nextPut: revision asString.
].
"Modified: / 23-11-2012 / 23:08:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseOutput:stream
"Parses output of 'hg' command, i.e. commit, log, update, checkout,
etc."
^ (self parserOn:stream) parseCommandUpdate
"Modified: / 14-01-2013 / 16:00:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGCommand::version methodsFor:'accessing'!
executable
^ executable notNil
ifTrue:[executable]
ifFalse:[self class hgCommand]
"Modified (format): / 21-01-2013 / 05:06:54 / jv"
!
executable:aString
executable := aString.
! !
!HGCommand::version methodsFor:'private'!
arguments
^ Array with: HGExecutable with: '--version'
"Created: / 19-11-2012 / 20:01:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseOutput:stream
"Parses output of 'hg' command, i.e. commit, log, update, checkout,
etc."
^ (self parserOn:stream) parseCommandVersion
"Created: / 19-11-2012 / 20:02:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGCommand class methodsFor:'documentation'!
version_HG
^ '$Changeset: <not expanded> $'
!
version_SVN
^ 'Id:: '
! !
HGCommand initialize!
HGCommand::resolve initialize!