"{ Package: 'cvut:stx/goodies/libsvn' }"

"{ NameSpace: SVN }"

Object subclass:#WorkingCopy

	instanceVariableNames:'path repository branch packageClassesChanged

		packageExtensionsChanged'

	classVariableNames:''

	poolDictionaries:''

	category:'SVN-Core'

!

!WorkingCopy class methodsFor:'instance creation'!

branch: aBranch path: aStringOrFilename

    ^self new 

        branch: aBranch; 

        path: aStringOrFilename;

        yourself

    "Created: / 19-08-2009 / 11:25:06 / Jan Vrany <vranyj1@fel.cvut.cz>"

! !

!WorkingCopy methodsFor:'accessing'!

branch

    branch ifNil:[ 

        branch := BranchQuery new 

                    repository: repository;

                    raiseRequest.

        branch ifNil:[branch := self defaultBranch]].

    ^ branch

    "Created: / 31-03-2008 / 12:50:17 / janfrog"

    "Modified: / 14-04-2008 / 12:44:25 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

branch: branchOrString

    branch := branchOrString isString

        ifFalse:

            [repository := branchOrString repository.

            branchOrString]

        ifTrue:

            [repository branches

                detect:[:branch|branch path = branchOrString]

                ifNone:[self error:'No such branch: ', branchOrString]].

    "Created: / 31-03-2008 / 13:29:13 / janfrog"

    "Modified: / 19-08-2009 / 11:22:45 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

commitMode

    "UI Helper"

    ^self packageClassesChanged ifTrue:[#full] ifFalse:[#fast]

    "Created: / 13-08-2009 / 15:12:41 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

commitMode: mode

    mode == #full ifTrue:[packageClassesChanged := true].

    "Created: / 13-08-2009 / 15:13:08 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

defaultBranch

    ^repository branches 

        detect:[:branch | branch isTrunk ]

        ifNone:[self error: 'No branch!!'].

    "Created: / 11-04-2008 / 13:15:34 / Jan Vrany <vranyj1@fel.cvut.cz>"

    "Modified: / 14-04-2008 / 11:53:04 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

manager

    ^repository manager

    "Created: / 11-06-2009 / 13:33:17 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

package

    ^repository package

    "Created: / 31-03-2008 / 13:04:52 / janfrog"

!

packageClasses

    ^self packageClassesWithPrivate reject:[:cls|cls owningClass notNil]

    "Created: / 31-03-2008 / 13:06:13 / janfrog"

    "Modified: / 23-03-2009 / 12:16:51 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

packageClassesChanged

    packageClassesChanged :=

        packageClassesChanged 

            or:[self computePackageClassesChanged].

    ^ packageClassesChanged

    "Modified: / 13-08-2009 / 10:21:19 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

packageClassesFiltered: classFilter

    ^self packageClasses select: [:class|classFilter value: class].

    "Created: / 23-03-2009 / 12:04:18 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

packageClassesWithPrivate

    ^ProjectDefinition searchForClassesWithProject: self package

    "Created: / 23-03-2009 / 12:06:58 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

packageClassesWithPrivateFiltered: classFilter

    ^self packageClassesWithPrivate select: [:class|classFilter value: class].

    "Created: / 23-03-2009 / 12:07:58 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

packageDefinition

    ^ Smalltalk 

        at:(ProjectDefinition initialClassNameForDefinitionOf:self package) 

                asSymbol.

    "Created: / 15-06-2009 / 12:41:20 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

packageExtensions

    ^ProjectDefinition searchForExtensionsWithProject: self package

    "Created: / 31-03-2008 / 13:06:13 / janfrog"

    "Modified: / 11-04-2008 / 08:25:00 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

packageExtensionsChanged

    packageExtensionsChanged :=

        packageExtensionsChanged

            or:[self computePackageExtensionsChanged].

    ^ packageExtensionsChanged

    "Modified: / 13-08-2009 / 10:22:23 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

packageExtensionsFiltered:aBlock

    ^self packageExtensions select:aBlock

    "Created: / 11-06-2009 / 13:37:27 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

path

    ^ path

    "Created: / 31-03-2008 / 12:42:42 / janfrog"

    "Modified: / 21-08-2009 / 17:47:30 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

path:aStringOrFilename

    path := aStringOrFilename asFilename.

    "Created: / 31-03-2008 / 12:42:42 / janfrog"

!

pathBase

    ^self manager workingCopyBase.

    "Created: / 11-06-2009 / 13:32:54 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

repository

    ^ repository

    "Created: / 31-03-2008 / 12:42:22 / janfrog"

!

repository:aRepository

    repository := aRepository.

    "Created: / 31-03-2008 / 12:42:22 / janfrog"

!

url

    ^branch url

    "Created: / 31-03-2008 / 13:05:01 / janfrog"

! !

!WorkingCopy methodsFor:'accessing - change sets'!

changeSet

    ^self changeSetIgnoreAutoloaded: false

    "Created: / 23-03-2009 / 18:57:16 / Jan Vrany <vranyj1@fel.cvut.cz>"

    "Modified: / 12-08-2009 / 14:26:55 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

changeSetForContainer: containerName

    ^ChangeSet fromStream:

        (self containerReadStreamFor: containerName)

    "Created: / 09-10-2008 / 20:21:56 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

changeSetForUpdate

    |diffSet classesToRemove|

    diffSet := self diffSetBetweenImageAndWorkingCopy.

    classesToRemove := Set new.

    SVN::ActivityNotification notify:'Computing update change set'.

    "self = image, arg = revision"

    ^(diffSet onlyInArg) ,

        (diffSet changed collect:[:changePair | changePair second ])

            , (diffSet onlyInReceiver 

                select:[:change | change isClassDefinitionChange ]

                thenCollect:

                    [:change |

                    classesToRemove add:change className.

                    ClassRemoveChange className:change className])

                , (diffSet onlyInReceiver 

                        select:

                            [:change | 

                            change isMethodDefinitionChange 

                                and:[ (classesToRemove includes:change className) not ]]

                            thenCollect:

                                [:change | 

                                MethodRemoveChange className:change className selector:change selector])

    "Created: / 24-03-2009 / 08:17:19 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

changeSetIgnoreAutoloaded: ignoreAutoloaded

    | containersToIgnore changeSet |

    containersToIgnore :=

        (self packageClassesFiltered:[:cls|cls isLoaded not])

            collect:[:cls|repository containerNameForClass: cls].

    changeSet := ChangeSet new.

    self containers do:

        [:container |

        (containersToIgnore includes: container)

            ifFalse:

                [changeSet addAll: 

                    (self changeSetForContainer: container)]].

    ^changeSet

    "Created: / 12-08-2009 / 14:26:39 / Jan Vrany <vranyj1@fel.cvut.cz>"

! !

!WorkingCopy methodsFor:'accessing - containers'!

containerFilenameFor: containerName

    ^self path construct: containerName

    "Created: / 09-10-2008 / 20:25:02 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

containerReadStreamFor: containerName

    | containerFile containerStream |

    containerFile := self containerFilenameFor: containerName. 

    OperatingSystem isMSWINDOWSlike

        ifTrue:

            ["

            Dirty hack for MS Windows:

            Windows do not allow me to open some files for the first

            time (OpenError is raised). Second try after some time is usually OK.

            I don't know why this happens. Claus, do you have any idea?

            "

            [ containerStream := containerFile readStream ]

                on: OpenError do: 

                    [Delay waitForMilliseconds: 100. "A magic constant here :-("

                    containerStream := containerFile readStream]]

        ifFalse:

            ["

            Unix behaves pretty fine :-)

            "

            containerStream := containerFile readStream].

    ^containerStream

    "Created: / 09-10-2008 / 20:26:03 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

containerSuffixes

    ^#(

          'st'   "Smalltalk"

        "/'js'   "JavaScript - not yet supported"

        "/'rb'   "Ruby - not yet supported"

        "/'pas'  "Pascal - not yet supported"

    )

    "Created: / 23-03-2009 / 18:53:56 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

containerWriteStreamFor: containerName

    ^(self containerFilenameFor: containerName) writeStream

        eolMode: #nl;

        yourself

    "Created: / 09-10-2008 / 20:24:44 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

containerWriteStreamForExtensions

    ^self containerWriteStreamFor: 'extensions.st'

    "Created: / 09-10-2008 / 20:23:47 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

containers

    ^(self path directoryContents 

        select:

            [:container|self containerSuffixes anySatisfy:

                [:suffix|container endsWith:suffix]]) asSet

    "Created: / 23-03-2009 / 18:52:27 / Jan Vrany <vranyj1@fel.cvut.cz>"

    "Modified: / 12-06-2009 / 21:44:06 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

containersToKeep

    | containers |

    containers := self packageClasses 

        collect:[:cls|self repository containerNameForClass: cls].

    self packageExtensions isEmpty ifFalse:

        [containers add: self repository containerNameForExtensions].

    ^containers asSet.

    "Created: / 12-06-2009 / 21:27:12 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

containersWriteStreamForClass:cls 

    ^self containerWriteStreamFor: (repository containerNameForClass:cls)

    "Created: / 09-10-2008 / 20:23:59 / Jan Vrany <vranyj1@fel.cvut.cz>"

! !

!WorkingCopy methodsFor:'accessing - diff sets'!

diffSetBetweenImageAndWorkingCopy

    | imageChangeSet revisionChangeSet |

    imageChangeSet := ChangeSet forPackage: self package ignoreAutoloaded: true.

    revisionChangeSet := self changeSetIgnoreAutoloaded: true.

    ^imageChangeSet diffSetsAgainst: revisionChangeSet

    "Created: / 24-03-2009 / 08:17:26 / Jan Vrany <vranyj1@fel.cvut.cz>"

    "Modified: / 12-08-2009 / 14:32:03 / Jan Vrany <vranyj1@fel.cvut.cz>"

! !

!WorkingCopy methodsFor:'accessing - tasks'!

commitTask

    ^CommitTask new workingCopy: self

    "Created: / 23-03-2009 / 11:47:27 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

updateTask

    ^UpdateTask new workingCopy: self

    "Created: / 24-03-2009 / 15:13:20 / Jan Vrany <vranyj1@fel.cvut.cz>"

! !

!WorkingCopy methodsFor:'commands'!

cat: file

    ^self cat: file revision: Revision head

    "Created: / 19-04-2008 / 10:52:22 / Jan Vrany <vranyj1@fel.cvut.cz>"

    "Modified: / 09-10-2008 / 20:16:53 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

cat: file revision: revision

    ^self branch cat: file revision: revision

    "Created: / 19-04-2008 / 10:52:34 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

checkout

    |pkgDef|

    pkgDef := self packageDefinition.

    self 

        checkout:(pkgDef ifNotNil:[ pkgDef svnRevision ] ifNil:[ Revision head ])

!

checkout: revision

    | checkoutInfo |

    self synchronized:

        [self ensurePathExists.

        SVN::ActivityNotification notify:'Checking out ' , self package.

        checkoutInfo := CheckoutCommand new

                            revision: revision;

                            workingCopy: self;

                            execute].

    ^checkoutInfo

    "Created: / 31-03-2008 / 12:57:58 / janfrog"

    "Modified: / 21-08-2009 / 17:45:43 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

cleanup

    self ensurePathExists.

    self isValid ifFalse:[^self].

    ^CleanupCommand new

        workingCopy: self path;

        execute.

    "Created: / 08-11-2008 / 08:12:50 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

commit:message 

    ^self commitTask

        message: message;

        do

    "Created: / 31-03-2008 / 13:11:15 / janfrog"

    "Modified: / 07-04-2008 / 08:52:13 / janfrog"

    "Modified: / 23-03-2009 / 11:48:06 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

log

    ^self branch log

    "Created: / 19-04-2008 / 10:52:53 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

log: aString

    ^self branch log: aString

    "Created: / 19-04-2008 / 10:53:06 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

revert

    self ensurePathExists.

    self isValid ifFalse:[^self checkout].

    ^RevertCommand new

        workingCopy: self path;

        execute.

    "Created: / 22-10-2008 / 16:46:18 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

revert: containers

    | revertInfo |

    self ensurePathExists.

    self isValid ifFalse:[^self checkout].

    self synchronized:

        [revertInfo := RevertCommand new

                            workingCopy: self path;

                            paths: containers;

                            execute].

    ^revertInfo

    "Created: / 03-11-2008 / 21:20:38 / Jan Vrany <vranyj1@fel.cvut.cz>"

    "Modified: / 07-11-2008 / 08:54:38 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

status

    | status |

    self ensureIsValid.

    self synchronized:

        [status := StatusCommand new

                    workingCopy: self;

                    execute].

    ^status

    "Created: / 11-04-2008 / 09:22:13 / Jan Vrany <vranyj1@fel.cvut.cz>"

    "Modified: / 19-08-2009 / 14:35:49 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

update

    | updateInfo |

    self ensurePathExists.

    self isValid ifFalse:[^self checkout].

    self synchronized:

        [updateInfo := UpdateCommand new

                            workingCopy: self path;

                            execute].

    ^updateInfo

    "Created: / 21-05-2008 / 09:44:56 / Jan Vrany <vranyj1@fel.cvut.cz>"