"

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

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 

    |anyFailure module directory mgr defClass |

    mgr := self sourceCodeManagerFor: packageID. 

    defClass := ProjectDefinition definitionClassForPackage: packageID.

    defClass validateDescription.

    anyFailure := false.

    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:[

                    realDirectory ~= directory ifTrue:[

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

                            mgr createModule:module directory:realDirectory

                        ].

                    ].

                    (mgr

                        createContainerForText:fileContents

                        inModule:module

                        package:realDirectory

                        container:realFileName)

                            ifFalse:[

                                Dialog warn:(resources

                                            stringWithCRs:'Cannot create new container: ''%3'' (in %1:%2)'

                                            with:module

                                            with:realDirectory

                                            with:realFileName)

                            ].

                ] ifFalse:[

                    (mgr

                        checkin:realFileName

                        text:fileContents

                        directory:realDirectory

                        module:module

                        logMessage:'automatically generated by browser'

                        force:false)

                            ifFalse:[

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

                                anyFailure := true.

                            ].

                ].

            ].

    ].

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

    self

        checkinClasses:(Array with:defClass)

        withInfo:'automatic checkIn'

        withCheck:false.

    self activityNotification:nil.

    anyFailure ifTrue:[

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

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

    ] ifFalse:[

        self activityNotification:'Build-support files checked into the repository.'.

    ].

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

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

    "Modified: / 25-07-2012 / 14:27:30 / cg"

    "Modified (format): / 25-07-2012 / 22:25:48 / cg"

!

checkinClass:aClass

    "check a class into the source repository.

     Asks interactively for a log-message."

    ^ self checkinClass:aClass withInfo:nil

!

checkinClass:aClass withInfo:aLogInfoOrNil

    "check a class into the source repository.

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

    ^ self checkinClass:aClass withInfo:aLogInfoOrNil withCheck:true

!

checkinClass:aClass withInfo:aLogInfoOrNil withCheck:doCheckClass

    "check a class into the source repository.

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

     If doCheckClass is true, the class is checked for send of halts etc."

    ^ self 

        checkinClass:aClass 

        withInfo:aLogInfoOrNil 

        withCheck:doCheckClass 

        usingManager:(self sourceCodeManagerFor:aClass)

    "Modified: / 21-12-2011 / 18:19:55 / cg"

!

checkinClass:aClass withInfo:aLogInfoOrNil withCheck:doCheckClass usingManager:managerOrNil

    "check a class into the source repository.

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

     If doCheckClass is true, the class is checked for send of halts etc."

    |logMessage checkinInfo mgr pri resources|

    aClass isLoaded ifFalse:[

        self information:(resources string:'Cannot checkin unloaded classes (%1)' with:aClass name).

        ^ false.

    ].

    mgr := managerOrNil.

    mgr isNil ifTrue:[

        mgr := self sourceCodeManagerFor:aClass.

        mgr isNil ifTrue:[

            ^ false

        ]

    ].

    self ensureCorrectVersionMethodsInClass:aClass usingManager:mgr.

    mgr supportsCheckinLogMessages ifTrue:[

        (self 

            getLogMessageForClassCheckinTakingDefaultsFromPreviousLogInfo:aLogInfoOrNil 

            forClass:aClass

            valuesInto:[:logMessageRet :checkinInfoRet |

                logMessage := logMessageRet.

                checkinInfo := checkinInfoRet.

            ]

        ) ifFalse:[^ false].

    ].

    resources := self classResources.

    (self classIsNotYetInRepository:aClass withManager:mgr) ifTrue:[

        (self createSourceContainerForClass:aClass usingManager:mgr) ifFalse:[

"/            self warn:'did not create a container for ''' , aClass name , ''''.

            ^ false

        ].

        ^ true.

    ].

    self activityNotification:(resources string:'checking in %1' with:aClass name).

    pri := Processor activePriority.

    Processor activeProcess withPriority:pri-1 to:pri

    do:[

        |revision aborted freshCreated|

        freshCreated := false.

        revision := aClass revision.

        revision isNil ifTrue:[ 

            mgr isContainerBased ifTrue:[

                "/ mhmh - check if it has a container.

                (mgr checkForExistingContainerForClass:aClass) ifFalse:[

                    (self createSourceContainerForClass:aClass usingManager:mgr) ifFalse:[

                        self warn:'Did not create/change repository container for ''' , aClass name allBold , ''''.

                        ^ false.

                    ].

                    freshCreated := true.

                ]

            ]

        ].

        doCheckClass value ifTrue:[

            "/ check if the class contains halts, error-sends etc.

            (self checkAndWarnAboutBadMessagesInClass:aClass checkAgainHolder:doCheckClass) ifFalse:[

                ^ false

            ].

        ].

        freshCreated ifFalse:[

            aborted := false.

            AbortOperationRequest handle:[:ex |

                aborted := true.

                ex return.

            ] do:[

                |checkinState cause|

                checkinState := false.

                cause := ''.

                [

                    checkinState := mgr checkinClass:aClass logMessage:logMessage

                ] on:SourceCodeManagerError do:[:ex| 

                    cause := ex description.

                    ex proceed.

                ].

                checkinState ifFalse:[

                    Transcript showCR:'checkin of ''' , aClass name , ''' failed - ', cause.

                    self warn:(resources stringWithCRs:'Checkin of "%1" failed\\' with:aClass name allBold),cause.

                    ^ false.

                ].

                checkinInfo notNil ifTrue:[

                    checkinInfo isStable ifTrue:[

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

                        self tagClass:aClass as:#stable.

                    ].

                    checkinInfo tagIt ifTrue:[

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

                        self tagClass:aClass as:(checkinInfo tag).

                    ].

                ].

            ].

            aborted ifTrue:[

                Transcript showCR:'Checkin of ''' , aClass name , ''' aborted'.

                AbortAllOperationWantedQuery query ifTrue:[

                    (Dialog 

                        confirm:(resources stringWithCRs:'Checkin of "%1" aborted.\\Cancel all ?' with:aClass name)

                        default:false)

                    ifTrue:[

                        AbortAllOperationRequest raise.

                    ]

                ].

                ^ false.

            ].

        ].

    ].

    ^ true

    "Created: / 21-12-2011 / 18:19:14 / cg"

!

checkinClasses:aCollectionOfClass

    "check a collection of classes into the source repository.

     Asks interactively for log-message."

    ^ self checkinClasses:aCollectionOfClass withInfo:nil

!

checkinClasses:aCollectionOfClasses withInfo:aLogInfoOrNil

    "check a bunch of classes into the source repository.

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

    ^ self

        checkinClasses:aCollectionOfClasses 

        withInfo:aLogInfoOrNil 

        withCheck:(UserPreferences current at:#checkClassesWhenCheckingIn ifAbsent:true)

!

checkinClasses:aCollectionOfClasses withInfo:aLogInfoOrStringNil withCheck:doCheckClasses

    "check a bunch of classes into the source repository.

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

    self checkinClasses:aCollectionOfClasses withInfo:aLogInfoOrStringNil withCheck:doCheckClasses usingManager:nil

    "Modified: / 21-12-2011 / 18:24:47 / cg"

!

checkinClasses:aCollectionOfClasses withInfo:aLogInfoOrStringNil withCheck:doCheckClasses usingManager:aManagerOrNil

    "check a bunch of classes into the source repository.

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

    |classes allClasses checkinInfoOrString resources yesOrNoToAll unchangedClasses|

    "/ ignore private classes

    classes := aCollectionOfClasses select:[:aClass | aClass owningClass isNil].

    classes isEmpty ifTrue:[

        self information:'Only private classes given - nothing checked in.'.

        ^ self

    ].

    classes := classes select:[:aClass | aClass isLoaded].

    classes isEmpty ifTrue:[

        self information:'Only unloaded classes given - nothing checked in.'.

        ^ self

    ].

    classes size == 1 ifTrue:[

        ^ self checkinClass:classes first withInfo:aLogInfoOrStringNil withCheck:doCheckClasses usingManager:aManagerOrNil.

    ].

    resources := self classResources.

    "ask once, for all classes"

    aLogInfoOrStringNil isNil ifTrue:[

        checkinInfoOrString := self 

                        getCheckinInfoFor:(resources string:'%1 classes to checkin' with:aCollectionOfClasses size)

                        initialAnswer:nil

                        withQuickOption:true.

        checkinInfoOrString isNil ifTrue:[^ self].

    ] ifFalse:[

        checkinInfoOrString := aLogInfoOrStringNil.

    ].

    allClasses := classes.    

    checkinInfoOrString quickCheckIn ifTrue:[

        classes := classes select:[:aClass | aClass hasUnsavedChanges].

        classes isEmpty ifTrue:[ Dialog information:'no changes to checkin (quickCheckIn)' ]

    ].

    "abortAll is handled, and also asked for here!!"

    AbortAllOperationRequest handleAndAnswerQueryIn:[

        classes notEmpty ifTrue:[

            self yesToAllNotification handle:[:ex |

                yesOrNoToAll := ex parameter.

                ex proceed

            ] do:[

                self yesToAllQuery handle:[:ex |

                    ex proceedWith:yesOrNoToAll

                ] do:[

                    classes do:[:aClass |

                        self activityNotification:(resources string:'checking in %1' with:aClass name).

                        "/ ca does not want boxes to pop up all over ...

                        UserInformation handle:[:ex |

                            Transcript showCR:ex description.

                            ex proceed.

                        ] do:[

                            AbortOperationRequest catch:[

                                self 

                                    checkinClass:aClass 

                                    withInfo:checkinInfoOrString 

                                    withCheck:doCheckClasses

                                    usingManager:aManagerOrNil

                            ]

                        ].

                    ].

                ]

            ].

        ].

        (checkinInfoOrString isStable or:[checkinInfoOrString tagIt])

        ifTrue:[

            "/mhmh - but tag should be set on all (even unchanged ones)

            "/ the other onces have already been tagged

            unchangedClasses := allClasses select:[:eachClass | (classes includes:eachClass) not].

            "mhmh - could still have to tag them"

            checkinInfoOrString isStable ifTrue:[

                unchangedClasses do:[:eachClass |

                    self tagClass:eachClass as:#stable.

                ].

            ].

            checkinInfoOrString tagIt ifTrue:[

                unchangedClasses do:[:eachClass |

                    self tagClass:eachClass as:(checkinInfoOrString tag).

                ].

            ].

        ].

    ].

    "Created: / 21-12-2011 / 18:24:25 / 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."

    |logMessage checkinInfo mgr pri resources module directory containerFileName methodSource|

    resources := self classResources.

    "/ 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:[

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

            UserInformation handle:[:ex |

                Transcript showCR:ex description.

                ex proceed.

            ] do:[

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

                (mgr 

                    checkin:containerFileName

                    text:methodSource

                    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

    "Modified: / 25-07-2012 / 18:38:40 / cg"

!

checkinPackage:packageToCheckIn classes:doClasses extensions:doExtensions buildSupport:doBuild askForMethodsInOtherPackages:askForMethodsInOtherPackages

    |mgr classes classesToCheckIn methodsToCheckIn

     methodsInOtherPackages looseMethods otherPackages

     msg classesInChangeSet checkinInfo originalCheckinInfo classesToTag|

    mgr := self sourceCodeManagerFor: packageToCheckIn.

    classes := Smalltalk allClasses.

    classesToCheckIn := IdentitySet new.

    methodsToCheckIn := IdentitySet new.

    methodsInOtherPackages := IdentitySet new.

    looseMethods := IdentitySet new.

    "/ classes ...

    classes do:[:aClass | |owner classPackage|

        (owner := aClass owningClass) notNil ifTrue:[

            classPackage := aClass topOwningClass package

        ] ifFalse:[

            classPackage := aClass package

        ].

        (classPackage = packageToCheckIn) ifTrue:[

            classesToCheckIn add:aClass.

        ].

    ].

    "/ cg: O(n^2) algorithm

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

    "/ replaced by: O(n) algorithm

    "/ individual methods ...

    classes do:[:aClass |

        aClass isMeta ifFalse:[

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

            (classesToCheckIn includes:aClass) ifFalse:[

                aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |