hg/stx-libscm: comparison mercurial/HGCommand.st

equal deleted inserted replaced

-:e2f6e7330c37
+:3df8f12dcece
 "
 !
 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>
 ^ 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:[
 "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 := self hgVersionOf: self hgCommand
 ].
 ^ 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) ]) ]
 ]
 ].
 "
 !
 hgVersionOf: hgcommand
 "Return mercurial version installed on this compiter"
 ^version new
 executable: hgcommand;
 execute
 "
 HGCommand hgVersion
 !
 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>"
 !
 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>"
 ! !
 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 ]
 ]
 ].
 blocker := (Semaphore new:-2) name: 'Waiting for hg command to finish'.
 Processor monitor:[
 Tracing ifTrue:[
-Logger log: 'cmd: executing: ' , (args asStringWith:' ') severity: #trace facility: 'HG'.
+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 signal.
 Tracing ifTrue:[
 Logger log: 'returning' severity: #trace facility: 'HG'.
 ].
 ^self status: status result: result
 "
 SVNv2::Command info: 'https://swing.fit.cvut.cz/svn/stx/libsvn'
 "
 ^ 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>"
 workers add: worker.
 worker addExitAction:[
 Tracing ifTrue:[
 Logger log: 'command parser finished' severity: #trace facility: 'HG'.
 ].
 blocker signal.
 workers remove: worker
 ].
 worker resume.
 "Created: / 04-02-2013 / 11:55:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 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>"
 ! !
 stream nextPut:'--debug' "/to get full node ids
 "Created: / 27-11-2012 / 19:54:35 / 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>"
 ! !
 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.
 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:[
 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>"
 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'!
 "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>"
 ! !
 "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>"
 !
 !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>"
 ! !
 ].
 "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>"
 ! !
 childrenOnly == true ifTrue:[
 template := HGCommandParser templateLogChildren.
 ].
 stream
 nextPut:'--debug';
 nextPut:'--template';
 nextPut:template.
 path notNil ifTrue:[
 "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>"
 ].
 "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>"
 !
 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>"
 ! !
 "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>"
 ! !
 "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>"
 !
 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>"
 ! !
 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>"
 !
 ^'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>"
 ! !
 ].
 "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>"
 ! !
 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>"
 ! !
 ].
 "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"
 !
 ^ 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>"
 ! !

changeset 227	3df8f12dcece
parent 216	0a3821d4bdb6
child 228	e00b7d71e234