"

stx:libscm - a new source code management library for Smalltalk/X

Copyright (C) 2012-2015 Jan Vrany

Copyright (C) 2020 LabWare

This library is free software; you can redistribute it and/or

modify it under the terms of the GNU Lesser General Public

License as published by the Free Software Foundation; either

version 2.1 of the License. 

This library is distributed in the hope that it will be useful,

but WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public

License along with this library; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

"

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

"{ NameSpace: Smalltalk }"

HGRepositoryObject subclass:#HGChangeset

	instanceVariableNames:'lazy id branches bookmarks author timestamp message summary

		parent1 parent2 root rootPackage changes obsolete successors'

	classVariableNames:'NullChangeset'

	poolDictionaries:''

	category:'SCM-Mercurial-Core'

!

!HGChangeset class methodsFor:'documentation'!

copyright

"

stx:libscm - a new source code management library for Smalltalk/X

Copyright (C) 2012-2015 Jan Vrany

Copyright (C) 2020 LabWare

This library is free software; you can redistribute it and/or

modify it under the terms of the GNU Lesser General Public

License as published by the Free Software Foundation; either

version 2.1 of the License. 

This library is distributed in the hope that it will be useful,

but WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public

License along with this library; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

"

!

documentation

"

    A HGChangeset represent one changeset in Mercurial repository.

    [author:]

        Jan Vrany <jan.vrany@fit.cvut.cz>

    [instance variables:]

    [class variables:]

    [see also:]

        http://mercurial.selenic.com/wiki/UnderstandingMercurial

"

! !

!HGChangeset class methodsFor:'instance creation'!

new

    "return an initialized instance"

    ^ self basicNew initialize.

! !

!HGChangeset class methodsFor:'accessing'!

null

    NullChangeset isNil ifTrue:[

        NullChangeset := self new.

        NullChangeset 

            setNonLazy;

            setId: HGChangesetId null;

            setParent1: nil;

            setParent2: nil;

            setAuthor: '';

            setMessage: '';

            setBranches: #();

            setTimestamp: (Timestamp utcSecondsSince1970:0).

    ].

    ^NullChangeset

    "

        HGChangesetId null

    "

    "Created: / 19-10-2012 / 15:51:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 25-09-2018 / 10:34:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGChangeset methodsFor:'accessing'!

/ name

    "Return an HGChangesetFile representing a file 

    (in root of the directory)"

    self ensureNotLazy.

    ^self construct: name

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

    "Modified: / 16-12-2012 / 00:34:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

author

    self ensureNotLazy.

    ^ author

    "Modified: / 16-12-2012 / 00:33:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

bookmarks

    "

    Return a list of bookmarks set on this changeset.

    "

    self == NullChangeset ifTrue:[ ^ #() ].

    ^ repository bookmarks select:[:bookmark | bookmark changesetId = id ]

    "Modified: / 25-09-2018 / 10:24:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

branch

    "Return branch (as HGBranch) in which this changeset is commited. It the changeset is commited in

     multiple branches, raise an error"

    self ensureNotLazy.

    branches size ~~ 1 ifTrue:[

        HGError 

            raiseSignalWith: self 

            errorString:('Changeset %1 commited in more than one branch' bindWith: id)

    ].

    ^self branches anElement

    "Created: / 27-11-2012 / 20:49:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 16-12-2012 / 00:34:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

branches

    "Return list of branches (as HGBranch) in which this changeset is commited"

    self ensureNotLazy.

    (branches anySatisfy:[:b|b isString]) ifTrue:[

        | all |

        all := repository branches.

        branches := branches collect:[:nm|all detect:[:b|b name = nm] ifNone:[HGNoSuchBranchError raiseSignalWith: nm errorString:'No such branch: ', nm]]

    ].

    ^branches.

    "Created: / 27-11-2012 / 20:40:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 16-12-2012 / 00:34:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

changes

    "Return a list of HGChange that describes differences against parent1 changeset"

    self ensureNotLazy.

    ^ changes

    "Created: / 05-12-2012 / 18:36:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 16-12-2012 / 00:34:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

children

    | ids |

    self ensureNotLazy.

    ids := self repository execute:

            (HGCommand log

                workingDirectory: repository pathName;

                childrenOnly: true;

                revset: id revno printString;

                yourself).

    self assert: ids size == 1.

    self assert: ids first first = id.

    ^ids first second collect:[:e|repository changesetWithId: e].

    "Created: / 05-12-2012 / 17:31:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 03-03-2013 / 23:09:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

construct: name

    "Return an HGChangesetFile representing a file 

    (in root of the directory)"

    self ensureNotLazy.    

    ^self root construct: name

    "Created: / 16-11-2012 / 22:25:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 16-12-2012 / 00:34:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

id

    ^ id

    "Modified: / 16-12-2012 / 00:34:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

labels

    ^OrderedCollection new  

        addAll: self branches;

        addAll: self bookmarks;

        addAll: self tags;

        yourself

    "Created: / 21-03-2014 / 01:45:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

message

    self ensureNotLazy.

    ^ message

    "Modified (format): / 16-12-2012 / 00:35:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

messageDigest

    | dialog |

    Display isNil ifTrue:[ 

        Smalltalk openDisplay.

        Display isNil ifTrue:[

            ^ nil "/ No way to ask for a changeset

        ]        

    ].

    dialog := HGChangesetDialog new.

    dialog repository: repository.

    dialog revset: ('merge() and branch(%1)' bindWith: repository workingCopy branch name) asHGRevset.

    dialog open ifTrue:[ 

        ^ self messageDigestUpTo: dialog changeset.

    ].

    ^ nil.

    "Created: / 03-06-2015 / 07:26:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

messageDigestUpTo: changeset

    "Return a a 'digested commit message' up to given changeset.

     The returned string is in form of

     ### shorthash 

     oldest commit message

     ### shoethash 

     middle commit message

     ### shoethash

     newest commit message

     This may be handy when exporting a commit to monticello to include

     commit message containing a digest of messages since last time the

     code was exported"

    | changesets |

    changesets := repository log: (changeset id printString, '::' , self id printString) limit: nil.

    ^ String streamContents:[ :s|

        changesets do:[:changeset | 

            s nextPutAll: '### '.    

            s nextPutLine: changeset id printStringWithoutNumber.

            s nextPutLine: changeset message.  

        ] separatedBy:[ 

            s cr.

        ].

    ]

    "

    (HGPackageWorkingCopy named: 'stx:libscm') repository workingCopy changeset messageDigest

    "

    "Created: / 03-06-2015 / 06:50:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 08-09-2015 / 01:45:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parent1

    self ensureNotLazy.

    parent1 class == HGChangesetId ifTrue:[

        parent1 := repository changesetWithId: parent1

    ].

    ^parent1

    "Modified: / 16-12-2012 / 00:35:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parent2

    self ensureNotLazy.

    parent2 class == HGChangesetId ifTrue:[

        parent2 := repository changesetWithId: parent2

    ].

    ^parent2

    "Modified: / 16-12-2012 / 00:35:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

root

    "Return an HGChangesetFile represening the root of

     the changeset,i.e, root of the directory tree 

     represented by given changeset"

    | filenames |

    root notNil ifTrue:[ ^ root ].

    self ensureNotLazy.

    filenames := HGCommand locate

                    workingDirectory: repository pathName;

                    revision: id revno;

                    hidden: true;

                    execute.

    root := HGChangesetFile new setChangeset: self name: ''.

    filenames do:[:each|root create: each].

    ^root.

    "Created: / 16-11-2012 / 22:26:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 16-12-2012 / 00:35:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 08-10-2020 / 17:51:45 / Jan Vrany <jan.vrany@labware.com>"

!

rootPackage

    "Return an HGPackageRevision represening the root St/X package

     in the repository at this revision"

    rootPackage isNil ifTrue:[ 

        rootPackage := HGPackageRevision changeset:self root:self root.

    ].

    ^ rootPackage

    "Created: / 06-03-2014 / 09:22:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

successors

    "Return the list of successors for this changeset.

     If there are no successors or successors are not supported

     (e.g., using Mercurial < 4.1), an empty array is returned.

    "

    | ids |    

    self == NullChangeset ifTrue:[ ^ #() ].

    HGCommand hgVersionIsGreaterOrEqualThan_4_1 ifFalse:[ ^ #() ].

    "/ In theory, we coould (and should) use HGCachedFileData, however

    "/ at least on UNIX systems the timestamp resolution is only 1sec

    "/ which is too coarse to work reliably on modern fast machines.

    "/

    "/ Sp, no caching until we get at least milliscond resolution. 

    "/ Sigh.

    "

    successors isNil ifTrue:[ 

        successors := HGCachedFileData

                        on: repository pathToHgStore00changelog_i

                        reader:[

                            | ids |    

                            ids := repository execute:

                                        (HGCommand log

                                            workingDirectory: repository path asString;

                                            revset: 'successors(', id printStringWithoutNumber, ')';

                                            hidden: true; 

                                            yourself).  

                            ids reject: [ :each | each id = id ] thenCollect:[ :each | repository changesetWithId: each id ]

                        ].       

    ].

    ^ successors value.

    "

    ids := repository execute:

                (HGCommand log

                    workingDirectory: repository path asString;

                    revset: 'successors(', id printStringWithoutNumber, ')';

                    hidden: true; 

                    yourself).  

    ^ids reject: [ :each | each id = id ] thenCollect:[ :each | repository changesetWithId: each id ]

    "Created: / 08-02-2018 / 15:27:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 25-09-2018 / 11:58:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

summary

    summary isNil ifTrue:[

        self ensureNotLazy.

        message isEmpty ifTrue:[ 

            summary := ''.

        ] ifFalse:[

            summary := message readStream nextLine.

        ]

    ].

    ^ summary

    "Created: / 11-03-2014 / 21:33:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 27-01-2016 / 08:35:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

tags

    "/ Not yet supported...

    ^ #()

    "Created: / 16-03-2014 / 23:05:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

timestamp

    self ensureNotLazy.

    ^ timestamp

    "Modified: / 16-12-2012 / 00:35:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

user

    ^ self author

    "Created: / 15-03-2014 / 13:31:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGChangeset methodsFor:'actions'!

bookmarkAs:aString

    "Create a new bookmark on receiver and return it.

     Raises an HGBookmarkError error if such bookmark already exists."

    ^ repository bookmark: self as: aString

    "Created: / 20-03-2014 / 17:13:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGChangeset methodsFor:'converting'!

asHGCRevset

    ^self id asHGRevset

    "Created: / 07-02-2014 / 13:03:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

asHGChangesetId

    ^self id

    "Created: / 14-01-2013 / 16:04:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGChangeset methodsFor:'enumerating'!

allChildrenDo: oneArgBlock

    "Evaluates given block for each child recursively."

    self childrenDo:[:e|

        oneArgBlock value: e.

        e allChildrenDo: oneArgBlock         

    ]

    "Created: / 05-12-2012 / 19:36:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

allParentsDo: oneArgBlock

    "Evaluates given block for each parent recursively."

    self parentsDo:[:e|

        oneArgBlock value: e.

        e allParentsDo: oneArgBlock         

    ]

    "Created: / 05-12-2012 / 19:36:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

childrenDo: oneArgBlock

    "Evaluates given block for each immediate child (i.e., does not

     recurse - use #allChildrenDo: to enmerate grand-children as well"

    self children do: oneArgBlock.

    "Created: / 05-12-2012 / 19:34:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parentsDo: oneArgBlock

    "Evaluates given block for each immediate parent (i.e., does not

     recurse - use #allParentsDo: to enmerate grand-parents as well"