"{ Encoding: utf8 }"

"

 COPYRIGHT (c) 2012 eXept Software AG

              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:libbasic3' }"

"{ NameSpace: Smalltalk }"

SourceCodeManagerUtilities subclass:#SourceCodeManagerUtilitiesForContainerBasedManagers

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'System-SourceCodeManagement'

!

!SourceCodeManagerUtilitiesForContainerBasedManagers class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2012 eXept Software AG

              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.

"

! !

!SourceCodeManagerUtilitiesForContainerBasedManagers methodsFor:'utilities-cvs'!

checkinBuildSupportFilesForPackage:packageID withInfo:checkinInfo

    ^ self checkinBuildSupportFilesForPackage:packageID withInfo:checkinInfo onBranch:nil

    "Created: / 09-08-2006 / 18:59:42 / fm"

    "Modified: / 12-10-2011 / 11:36:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 05-12-2017 / 20:31:34 / cg"

!

checkinBuildSupportFilesForPackage:packageID withInfo:checkinInfo onBranch:branchNameOrNil

    |anyFailure module directory mgr defClass checkedInFiles|

    mgr := self sourceCodeManagerFor: packageID. 

    defClass := ProjectDefinition definitionClassForPackage: packageID.

    "/ already done elsewhere now

    "/ defClass validateDescription.

    anyFailure := false.

    checkedInFiles := StringCollection new.

    module := packageID asPackageId module.

    directory := packageID asPackageId directory.

    self activityNotification:(resources string:'Checking in build-support files...').

    (mgr checkForExistingModule:module directory:directory) ifFalse:[

        mgr createModule:module directory:directory

    ].

    defClass forEachFileNameAndGeneratedContentsDo:[:fileName :fileContents |

        |realFileName realDirectory|

        "/ care for subdirectories

        (fileName includes:$/) ifTrue:[

            realDirectory := (directory asFilename construct:(fileName asFilename directoryName)) name.

            realFileName := fileName asFilename baseName.

        ] ifFalse:[

            realDirectory := directory.

            realFileName := fileName.

        ].

        realDirectory := realDirectory replaceAll:$\ with:$/.

        self activityNotification:(resources string:'Checking in %1...' with:realFileName).

        UserInformation

            handle:[:ex | Transcript showCR:ex description ]

            do:[

                (mgr isContainerBased

                 and:[(mgr checkForExistingContainer:realFileName inModule:module directory:realDirectory) not]

                ) ifTrue:[

                    "/ a new file

                    realDirectory ~= directory ifTrue:[

                        (mgr checkForExistingModule:module directory:realDirectory) ifFalse:[

                            mgr createModule:module directory:realDirectory

                        ].

                    ].

                    [:exit |

                        |answer|

                        (mgr

                            createContainerForText:fileContents

                            inModule:module

                            package:realDirectory

                            container:realFileName) ifTrue:[

                                "success"

                                checkedInFiles add:fileName.

                                exit value:nil 

                        ].

                        answer := Dialog 

                            confirmWithCancel:(resources

                                    stringWithCRs:'Cannot create new container: ''%3'' (in %1:%2).\\Retry?'

                                    with:module

                                    with:realDirectory

                                    with:realFileName).

                         answer == nil ifTrue:[

                            AbortOperationRequest raise

                        ].

                        answer == false ifTrue:[ exit value:nil ].

                    ] loopWithExit.

                ] ifFalse:[

                    "/ an existing file

                    (mgr

                        checkin:realFileName

                        text:fileContents

                        directory:realDirectory

                        module:module

                        logMessage:checkinInfo logMessage

                        force:false

                        onBranch:branchNameOrNil

                    ) ifTrue:[

                        checkinInfo isStable ifTrue:[

                            self tagPath:(module, '/', realDirectory, '/', realFileName) as:#stable usingManager:mgr.

                        ].

                        checkinInfo tagIt ifTrue:[

                            self tagPath:(module, '/', realDirectory, '/', realFileName) as:checkinInfo tag usingManager:mgr.

                        ].

                        checkedInFiles add:fileName.

                    ] ifFalse:[

                        Transcript showCR:'checkin of ' , realFileName , ' failed'.

                        anyFailure := true.

                    ].

                ].

            ].

    ].

    defClass instAndClassMethodsDo:[:m | m package:defClass package].

    [

        self

            checkinClasses:(Array with:defClass)

            withInfo:checkinInfo

            withCheck:false

            usingManager:nil

            confirmNewContainer:false.

    ] ifCurtailed:[

        self activityNotification:'Checkin of build-support files aborted - see Transcript'.

    ].

    anyFailure ifTrue:[

        self warn:'Checkin failed - see Transcript.'.

        self activityNotification:'Checkin of build-support files failed - see Transcript.'.

    ] ifFalse:[

        checkedInFiles isEmpty ifTrue:[

            self activityNotification:'No build-support files were checked in.'.

        ] ifFalse:[

            self activityNotification:('Build-support files checked into the repository: %1.' bindWith:(checkedInFiles asStringWith:', ')).

        ].

    ].

    "Created: / 05-12-2017 / 20:31:18 / cg"

    "Modified: / 05-12-2017 / 23:32:16 / cg"

!

checkinExtensionMethods:aCollectionOfMethods forPackage:aPackageID withInfo:aLogInfoOrStringOrNil

    "checkin a projects extensions into the source repository.

     If the argument, aLogInfoOrStringOrNil isNil, ask interactively for log-message."

    ^ self checkinExtensionMethods:aCollectionOfMethods forPackage:aPackageID withInfo:aLogInfoOrStringOrNil onBranch:nil

    "Modified: / 05-12-2017 / 20:13:21 / cg"

!

checkinExtensionMethods:aCollectionOfMethods forPackage:aPackageID withInfo:aLogInfoOrStringOrNil onBranch:branchNameOrNil

    "checkin a projects extensions into the source repository.

     If the argument, aLogInfoOrStringOrNil isNil, ask interactively for log-message."

    |logMessage checkinInfo mgr pri module directory containerFileName extensionsSource|

    "/ the following is wrong - must ask the projectDefinition !!

    aPackageID asPackageId projectDefinitionClass notNil ifTrue:[

        mgr := self sourceCodeManagerFor:aPackageID asPackageId projectDefinitionClass.

    ] ifFalse:[

        mgr := self sourceCodeManagerFor:aCollectionOfMethods first mclass.

    ].

    mgr isNil ifTrue:[ ^ false ].

    module := aPackageID asPackageId module.

    directory := aPackageID asPackageId directory.

    containerFileName := self nameOfExtensionsContainer.

    aLogInfoOrStringOrNil isNil ifTrue:[

        checkinInfo := self getCheckinInfoFor:containerFileName allBold initialAnswer:nil.

        checkinInfo isNil ifTrue:[^ false].

        logMessage := checkinInfo logMessage.

    ] ifFalse:[

        aLogInfoOrStringOrNil isString ifTrue:[

            logMessage := aLogInfoOrStringOrNil

        ] ifFalse:[

            checkinInfo := aLogInfoOrStringOrNil.

            logMessage := checkinInfo logMessage.

        ].

    ].

    (mgr checkForExistingContainer:containerFileName inModule:module directory:directory) ifFalse:[

        (self checkForExistingModule:module usingManager:mgr allowCreate:true) ifFalse:[^ false].

        LastModule := module.

        (self checkForExistingModule:module directory:directory usingManager:mgr allowCreate:true) ifFalse:[^ false].

        LastPackage := directory.

        (self checkForExistingModule:module directory:directory container:containerFileName usingManager:mgr allowCreate:true) ifFalse:[^ false].

    ].

    self activityNotification:(resources string:'Checking in %1' with:containerFileName).

    pri := Processor activePriority.

    Processor activeProcess 

        withPriority:pri-1 to:pri

        do:[

            extensionsSource := self sourceCodeForExtensions:aCollectionOfMethods package:aPackageID forManager:mgr.

            "Care for non-ASCII/non-ISO-8859 characters in extension methods"

            extensionsSource isWideString ifTrue:[

                extensionsSource := '"{ Encoding: utf8 }"' , Character cr asString , Character cr asString , extensionsSource.                

                extensionsSource := extensionsSource utf8Encoded.

            ].

            UserInformation handle:[:ex |

                Transcript showCR:ex description.

                ex proceed.

            ] do:[

                Transcript showCR:('checking in ',containerFileName,' ...').

                (mgr 

                    checkin:containerFileName

                    text:extensionsSource

                    directory:directory 

                    module:module

                    logMessage:logMessage

                    force:false) 

                ifFalse:[

                    Transcript showCR:'Checkin of ''' , containerFileName , ''' failed'.

                    self warn:'Checkin of ''' , containerFileName allBold , ''' failed'.

                    ^ false.

                ].

                checkinInfo notNil ifTrue:[

                    |path|

                    path := (module, '/', directory, '/', containerFileName).

                    checkinInfo isStable ifTrue:[

                        "set stable tag for class that has been checked in"

                        self tagPath:path as:#stable usingManager:mgr.    

                    ].

                    checkinInfo tagIt ifTrue:[

                        "set an additional tag for class that has been checked in"

                        self tagPath:path as:(checkinInfo tag) usingManager:mgr.    

                    ].

                ].

                mgr postCheckInExtensionsForPackage:aPackageID    

            ].

        ].

    ^ true

    "Created: / 05-12-2017 / 20:12:50 / cg"

!

checkinPackage:packageToCheckIn classes:doClasses extensions:doExtensions buildSupport:doBuildSupportFiles askForMethodsInOtherPackages:askForMethodsInOtherPackages onBranch:branchNameOrNil

    |mgr classesToCheckIn extensionMethodsToCheckIn methodsInPrjDef

     methodsInOtherPackages looseMethods otherPackages

     msg classesInChangeSet newClasses checkinInfo originalCheckinInfo classesToTag

     answer|

    mgr := self sourceCodeManagerFor: packageToCheckIn.

    classesToCheckIn := IdentitySet new.

    classesInChangeSet := IdentitySet new.

    extensionMethodsToCheckIn := IdentitySet new.

    methodsInOtherPackages := IdentitySet new.

    looseMethods := IdentitySet new.

    "/ collect classes and individual methods...

    (doClasses or:[doExtensions]) ifTrue:[

        Smalltalk allClassesDo:[:aClass | 

            |owner classPackage|

            (owner := aClass owningClass) notNil ifTrue:[

                classPackage := aClass topOwningClass package

            ] ifFalse:[

                classPackage := aClass package

            ].

            (classPackage = packageToCheckIn) ifTrue:[

                classesToCheckIn add:aClass.

            ].

            doExtensions ifTrue:[

                aClass isMeta ifFalse:[

                    "/ ... whose class is not in the checkIn-set

                    (classesToCheckIn includes:aClass) ifFalse:[

                        aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |

                            "/ methods in this project ...

                            (mthd package = packageToCheckIn) ifTrue:[

                                extensionMethodsToCheckIn add:mthd

                            ]

                        ]

                    ].

                ].

            ].

        ].

        "/ cg: O(n^2) algorithm

        "/  classesInChangeSet := classesToCheckIn select:[:cls | cls hasUnsavedChanges].

        "/ replaced by: O(n) algorithm

        classesInChangeSet := ChangeSet current selectClassesForWhichIncludesChangeForClassOrMetaclassOrPrivateClassFrom:classesToCheckIn. 

    ].

    doExtensions ifTrue:[

        extensionMethodsToCheckIn notEmpty ifTrue:[

            doClasses ifTrue:[

                msg := '%1 classes (%4 changed) '.

            ] ifFalse:[

                msg := ''.

            ].

            doExtensions ifTrue:[

                doClasses ifTrue:[

                    msg := msg , 'and '.

                ].

                msg := msg , '%2 extensions '.

            ].

            msg := msg , 'of project "%3"'.

            checkinInfo := self

                        getCheckinInfoFor:(msg

                                                    bindWith:classesToCheckIn size

                                                    with:extensionMethodsToCheckIn size

                                                    with:packageToCheckIn allBold

                                                    with:classesInChangeSet size)

                        initialAnswer:nil

                        withQuickOption:(classesToCheckIn size > 0)

                        withValidateConsistencyOption:true.

            checkinInfo isNil ifTrue:[

                ^ self.

            ].

            checkinInfo validateConsistency ifTrue:[

                |setInProjectDef setForCheckin onlyInPrjDef onlyForCheckin moreInfo|

                self validateConsistencyOfPackage:packageToCheckIn doClasses:doClasses doExtensions:doExtensions.

                "/ could have changed/recompiled methods...

                "/ mhmh - should we checkin what is specified in the prj-def,

                "/ or what is actually present in the image (in case user did not repair)???

                packageToCheckIn asPackageId projectDefinitionClass notNil ifTrue:[

                    methodsInPrjDef  := packageToCheckIn asPackageId projectDefinitionClass extensionMethods.

                    methodsInPrjDef := methodsInPrjDef reject:[:m | m isNil].

                    (setInProjectDef := methodsInPrjDef asSet) ~= (setForCheckin := extensionMethodsToCheckIn asSet) ifTrue:[

                        onlyInPrjDef := setInProjectDef copy removeAllFoundIn:setForCheckin.

                        onlyForCheckin := setForCheckin copy removeAllFoundIn:setInProjectDef.

                        moreInfo := ''.

                        onlyInPrjDef notEmpty ifTrue:[

                            moreInfo := moreInfo , '\Only in Project: '.

                            moreInfo := moreInfo , (((onlyInPrjDef asOrderedCollection copyTo:(5 min:onlyInPrjDef size))

                                                    collect:#whoString) asStringWith:', ').

                            onlyInPrjDef size > 5 ifTrue:[ moreInfo := moreInfo , '...' ].

                        ].

                        onlyForCheckin notEmpty ifTrue:[

                            moreInfo := moreInfo , '\Only in Image: '.

                            moreInfo := moreInfo , (((onlyForCheckin asOrderedCollection copyTo:(5 min:onlyForCheckin size))

                                                    collect:#whoString) asStringWith:', ').

                            onlyForCheckin size > 5 ifTrue:[ moreInfo := moreInfo , '...' ].

                        ].

                        moreInfo notEmpty ifTrue:[ (moreInfo := moreInfo , '\') withCRs ].

    self halt.

                        answer:= Dialog 

                            confirmWithCancel:('The set of methods in image is different from what is specified in the project definition.\%1\You should probably make sure that all extension methods are all associated to the correct package.\\Check in image methods (%2) or definition methods (%3)?'

                                            bindWith: moreInfo

                                            with: extensionMethodsToCheckIn size

                                            with: methodsInPrjDef size) withCRs

                            labels:#('Image Methods' 'Definition Methods' 'Cancel') 

                            values:#(true false nil) 

                            default:nil.

    "/                    answer := Dialog 

    "/                        confirm:('Set of methods in image is different from what is specified in the project definition.\Check in image methods (%1) or definition methods (%2)?'

    "/                                        bindWith: extensionMethodsToCheckIn size

    "/                                        with: methodsInPrjDef size)

    "/                        yesLabel:'Image Methods' 

    "/                        noLabel:'Definition Methods'.

                        answer isNil ifTrue:[AbortOperationRequest raise].

                        answer ifFalse:[

                            extensionMethodsToCheckIn := methodsInPrjDef.

                        ].

                    ].

                    "/ also need the extensionVersion methods in the projectDefinition class,

                    "/ which are kept in the extensions container. (the reason is that we need the proper

                    "/ CVS id for the extensions container, not for the projDefinition container.

                    packageToCheckIn asPackageId projectDefinitionClass theMetaclass selectorsAndMethodsDo:[:sel :mthd |

                        (AbstractSourceCodeManager isExtensionsVersionMethodSelector:sel) ifTrue:[

                            extensionMethodsToCheckIn add:mthd

                        ].

                    ].

                ].

            ].

            (self

                checkinExtensionMethods:extensionMethodsToCheckIn

                forPackage:packageToCheckIn

                withInfo:checkinInfo

                onBranch:branchNameOrNil)

            ifFalse:[

                Dialog warn:(resources string:'Could not check in extensions for project %1' with:packageToCheckIn).

                ^ self.

            ]

        ] ifFalse:[

            "/ there may have been extension-methods previously - if so, remove them

            (mgr

                checkForExistingContainer:'extensions.st' inPackage:packageToCheckIn)

            ifTrue:[

                (self

                    checkinExtensionMethods:#()

                    forPackage:packageToCheckIn

                    withInfo:'No extensions any more'

                    onBranch:branchNameOrNil)

                ifFalse:[

                    Dialog warn:(resources string:'Could not check in extensions for project %1' with:packageToCheckIn).

                    ^ self.

                ]

            ]

        ].

    ].

    checkinInfo isNil ifTrue:[

        |infoString|

        doExtensions ifTrue:[

            extensionMethodsToCheckIn size == 0 ifTrue:[

                infoString := '"%3": %1 classes (%4 changed)'.

            ] ifFalse:[    

                infoString := '"%3": %1 classes (%4 changed), %2 extensions'.

            ].

        ] ifFalse:[doClasses ifTrue:[

            infoString := '"%3": %1 classes (%4 changed)'.

        ] ifFalse:[doBuildSupportFiles ifTrue:[

            infoString := '"%3": build support files'.

        ] ifFalse:[

            infoString := 'I don''t know what I am doing'.

        ]]].

        infoString := infoString

                        bindWith:classesToCheckIn size

                        with:extensionMethodsToCheckIn size

                        with:packageToCheckIn allBold

                        with:classesInChangeSet size.

        mgr notNil ifTrue:[

            mgr isCVS ifTrue:[

                |repos|

                repos := mgr repositoryForPackage:packageToCheckIn.

                repos notNil ifTrue:[

                    infoString := infoString,Character cr,('CVS Repository: "%1"' bindWith:repos)

                ].    

            ].    

        ].

        branchNameOrNil notNil ifTrue:[

            infoString := infoString,Character cr,('Branch: "%1"' bindWith:branchNameOrNil)

        ].    

        checkinInfo := self

                    getCheckinInfoFor:infoString

                    initialAnswer:nil

                    withQuickOption:(classesToCheckIn size > 0)

                    withValidateConsistencyOption:true.

        checkinInfo isNil ifTrue:[

            ^ self.

        ].

        checkinInfo validateConsistency ifTrue:[

            self validateConsistencyOfPackage:packageToCheckIn doClasses:doClasses doExtensions:doExtensions.

        ].

    ].

    checkinInfo quickCheckIn ifTrue:[

        (checkinInfo isStable or:[checkinInfo tagIt]) ifTrue:[

            classesToTag := classesToCheckIn.

            originalCheckinInfo := checkinInfo.

            checkinInfo := checkinInfo deepCopy.

            checkinInfo isStable:false.

            checkinInfo tag:nil.

        ].

        "/ not only the one's in the changeSet;

        "/ also those which have not been checked in before.

        newClasses := classesToCheckIn select:[:class | (class revisionOfManager:mgr) isNil ].

        classesToCheckIn := Set new. 

        classesToCheckIn addAll:classesInChangeSet; addAll:newClasses.

    ].