mercurial/HGRevisionInfo.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Wed, 21 Nov 2012 01:21:47 +0000
changeset 88 1ad71a063a20
parent 84 mercurial/HGVersionInfo.st@76c669414145
child 91 f07d8ef6c01a
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:#HGVersionInfo
	instanceVariableNames:'changesetId className'
	classVariableNames:''
	poolDictionaries:''
	category:'SCM-Mercurial-StX'
!

!HGVersionInfo class methodsFor:'documentation'!

documentation
"
    A Mercurial-specific VersionInfo.

    [author:]
        Jan Vrany <jan.vrany@fit.cvut.cz>

    [see also:]
        VersionInfo
        CVSVersionInfo
"
! !

!HGVersionInfo class methodsFor:'instance creation'!

readFrom: aStringOrStream onError: aBlock
    | s id |

    s := aStringOrStream readStream.
    s skipSeparators.
    s peek ~~ $$ ifTrue:[^aBlock value].
    s next.
    s skipSeparators.
    (s next: 10) ~= 'Changeset:' ifTrue:[^aBlock value].
    s skipSeparators.
    id := HGNodeId fromHexString: (s next: 40).
    ^self new changesetId: id

    "Created: / 20-11-2012 / 00:33:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 20-11-2012 / 10:07:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGVersionInfo methodsFor:'accessing'!

at:aKey
    "backward compatible dictionary-like accessing"

    (self respondsTo:aKey) ifTrue:[
        ^ self perform:aKey
    ].
    ^ self errorKeyNotFound:aKey

    "
     self new at:#binaryRevision
     self new at:#foo
    "

    "Modified: / 22-10-2008 / 20:23:31 / cg"
!

at:aKey ifAbsent:replacement
    "backward compatible dictionary-like accessing"

    (self respondsTo:aKey) ifTrue:[
        ^ (self perform:aKey) ? replacement
    ].
    ^ replacement

    "
     self new at:#binaryRevision
     self new at:#foo ifAbsent:#bar
    "

    "Created: / 22-10-2008 / 20:19:42 / cg"
!

at:aKey put:value
    "backward compatible dictionary-like accessing"

    (self respondsTo:aKey) ifTrue:[
        self perform:(aKey,':') asSymbol with:value.
        ^ value "/ sigh
    ].
    ^ self errorKeyNotFound:aKey

    "
     self new at:#binaryRevision put:#bar
     self new at:#foo put:#bar
    "

    "Created: / 22-10-2008 / 20:20:54 / cg"
!

changesetId
    ^ changesetId
!

changesetId:anHGNodeId
    changesetId := anHGNodeId.
! !

!HGVersionInfo methodsFor:'accessing-properties'!

author
    ^ self user

    "Created: / 21-12-2011 / 23:09:54 / cg"
!

binaryRevision
    ^ changesetId printString

    "Modified: / 20-11-2012 / 10:26:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

binaryRevision: aString

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

date
    ^ nil

    "Modified: / 20-11-2012 / 10:26:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

fileName
    | cls |

    className isNil ifTrue:[ ^ nil ].
    cls := Smalltalk at: className.
    ^cls notNil ifTrue:[
        className , '.' , (cls programingLanguage sourceFileSuffix)
    ] ifFalse:[
        className , '.st'
    ].

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

repositoryPathName

    ^ self fileName

    "Modified: / 20-11-2012 / 10:03:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

revision
    ^ changesetId printString

    "Modified: / 20-11-2012 / 10:15:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

time
    ^ nil

    "Modified: / 20-11-2012 / 10:15:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

timezone
    "raise an error: must be redefined in concrete subclass(es)"

    ^ nil "Not known"

    "Modified: / 23-11-2011 / 13:54:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

user
    ^ nil

    "Modified: / 20-11-2012 / 10:15:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGVersionInfo methodsFor:'enumerating'!

keysAndValuesDo:aBlock
    self class instVarNames do:[:nm |
        aBlock value:(nm asSymbol) value:(self perform:nm asSymbol)
    ].

    "Created: / 22-10-2008 / 20:48:08 / cg"
! !

!HGVersionInfo methodsFor:'private'!

properties
    #(
        revision
        binaryRevision
        user
        date
        time
        fileName
        repositoryPathName
    )

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

!HGVersionInfo class methodsFor:'documentation'!

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