"

 COPYRIGHT (c) 2000 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' }"

Object subclass:#SourceCodeManagerUtilities

	instanceVariableNames:''

	classVariableNames:'LastSourceLogMessage LastModule LastPackage YesToAllQuery

		YesToAllNotification'

	poolDictionaries:''

	category:'System-SourceCodeManagement'

!

SimpleDialog subclass:#CheckinInfoDialog

	instanceVariableNames:'descriptionHolder logMessageHolder isStableHolder'

	classVariableNames:'LastSourceLogMessage'

	poolDictionaries:''

	privateIn:SourceCodeManagerUtilities

!

!SourceCodeManagerUtilities class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2000 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.

"

!

documentation

"

    utility code which is useful at more than one place

    (extracted from the browser)

    [author:]

        Claus Gittinger (cg@exept)

    [see also:]

    [instance variables:]

    [class variables:]

"

! !

!SourceCodeManagerUtilities class methodsFor:'Signal constants'!

yesToAllNotification

    YesToAllNotification isNil ifTrue:[

        YesToAllNotification := QuerySignal new.

    ].

    ^ YesToAllNotification

!

yesToAllQuery

    YesToAllQuery isNil ifTrue:[

        YesToAllQuery := QuerySignal new.

    ].

    ^ YesToAllQuery

! !

!SourceCodeManagerUtilities class methodsFor:'accessing'!

lastModule

    "return the value of the static variable 'LastModule' (automatically generated)"

    ^ LastModule

!

lastModule:something

    "set the value of the static variable 'LastModule' (automatically generated)"

    LastModule := something.

!

lastPackage

    "return the value of the static variable 'LastPackage' (automatically generated)"

    ^ LastPackage

!

lastPackage:something

    "set the value of the static variable 'LastPackage' (automatically generated)"

    LastPackage := something.

! !

!SourceCodeManagerUtilities class methodsFor:'utilities'!

setPackageOfAllMethodsIn:aClass to:aPackage

    "make all methods belong to the classes project"

    |anyChange anyChangeHere|

    anyChange := false.

    aClass withAllPrivateClassesDo:[:eachClass |

        anyChangeHere := false.

        eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd | 

            mthd package ~= aPackage ifTrue:[

                mthd setPackage:aPackage.

                anyChangeHere := true.

            ].

        ].

        anyChangeHere ifTrue:[

            eachClass changed:#projectOrganization

        ].

        anyChangeHere ifTrue:[anyChange := true].

    ].

    anyChange ifTrue:[

       Smalltalk changed:#projectOrganization

    ].

    ^ anyChange

!

sourceCodeManagerFor:aClass

    |mgr|

    mgr := (aClass sourceCodeManager).

    mgr isNil ifTrue:[

        SourceCodeManager isNil ifTrue:[

            (self warn:'SourceCodeManagement is disabled or not configured.\\Please setup in the Launcher.' withCRs) ifFalse:[

                ^ nil

            ].

        ].

        (self confirm:'Class does not seem to provide a valid sourceCodeManager.\\Assume CVS ?' withCRs) ifFalse:[

            ^ nil

        ].

        mgr := CVSSourceCodeManager.

    ].

    ^ mgr

!

sourceCodeOfClass:aClass

    |stream src|

    stream := '' writeStream.

    Method flushSourceStreamCache.

    aClass fileOutOn:stream withTimeStamp:false.

    src := stream contents asString.

    stream close.

    ^ src

! !

!SourceCodeManagerUtilities class methodsFor:'utilities-cvs'!

checkForExistingModule:module package:package container:containerFileName using:mgr allowCreate:allowCreate

    |resources moduleName packageName containerName|

    resources := self classResources.

    moduleName := module allBold.

    packageName := package allBold.

    containerName := containerFileName allBold.

    "/

    "/ check for the container

    "/

    (mgr checkForExistingContainerInModule:module package:package container:containerFileName) ifFalse:[

        allowCreate ifFalse:[

            self warn:(resources string:'A container for ''%1'' does not exist in ''%2:%3''' 

                                   with:containerName with:moduleName with:packageName) withCRs.

            ^ false

        ].

        (Dialog 

            confirm:(resources string:'''%1'' is a new container (in ''%2:%3'').\\Create it ?' 

                                 with:containerName with:moduleName with:packageName) withCRs

            noLabel:'Cancel') 

        ifFalse:[

            ^ false.

        ].

        (mgr createContainerForText:'' inModule:module package:package container:containerFileName) ifFalse:[

            self warn:(resources string:'Cannot create new container: ''%1'' (in ''%2:%3'')' 

                                 with:containerName with:moduleName with:packageName).

            ^ false.

        ]

    ].

    ^ true.

!

checkForExistingModule:module package:package using:mgr allowCreate:allowCreate

    |resources moduleName packageName|

    resources := self classResources.

    moduleName := module allBold.

    packageName := package allBold.

    "/

    "/ check for the package

    "/

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

        allowCreate ifFalse:[

            self warn:(resources string:'A package named ''%1'' does not exist in module ''%2''' 

                                   with:packageName with:moduleName) withCRs.

            ^ false

        ].

        (Dialog 

            confirm:(resources string:'''%1'' is a new package in module ''%2''.\\create it ?' 

                                 with:packageName with:moduleName) withCRs

            noLabel:'Cancel') 

        ifFalse:[

            ^ false.

        ].

        (mgr createModule:module package:package) ifFalse:[

            self warn:(resources string:'Cannot create new package: ''%1'' in module ''%2''' 

                                   with:packageName with:moduleName) withCRs.

            ^ false.

        ]

    ].

    ^ true.

!

checkForExistingModule:module using:mgr allowCreate:allowCreate

    |resources moduleName|

    (mgr checkForExistingModule:module) ifFalse:[

        resources := self classResources.

        moduleName := module allBold.

        allowCreate ifFalse:[

            self warn:(resources stringWithCRs:'A module named ''%1'' does not exist in the repository' 

                                  with:moduleName) .

            ^ false

        ].

        (Dialog 

            confirm:(resources stringWithCRs:'''%1'' is a new module.\\create it ?' with:moduleName) 

            noLabel:'Cancel') 

        ifFalse:[

            ^ false.

        ].

        (mgr createModule:module) ifFalse:[

            self warn:(resources stringWithCRs:'Cannot create new module: ''%1''' with:moduleName) .

            ^ false.

        ]

    ].

    ^ true.

!

checkinClass:aClass

    "check a class into the source repository.

     Asks interactively for log-message."

    ^ self checkinClass:aClass withLog:nil

!

checkinClass:aClass withLog:aLogMessageOrNil

    "check a class into the source repository.

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

    ^ self checkinClass:aClass withLog:aLogMessageOrNil withCheck:true

!

checkinClass:aClass withLog:aLogMessageOrNil withCheck:doCheckClass

    "check a class into the source repository.

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

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

    |logMessage checkinInfo info mgr pri resources newSelectors initialLog|

    aClass isLoaded ifFalse:[

        self information:'cannot checkin unloaded classes (' , aClass name , ').'.

        ^ false.

    ].

    mgr := self sourceCodeManagerFor:aClass.

    mgr isNil ifTrue:[

        ^ false

    ].

    aLogMessageOrNil isNil ifTrue:[

        newSelectors := aClass selectors asSet.

        newSelectors addAll:(aClass class selectors).

        newSelectors size == 1 ifTrue:[

            initialLog := 'Added/changed #' , newSelectors first

"/        ] ifFalse:[

"/            newSelectors size > 1 ifTrue:[

"/                initialLog := 'Added/changed some methods'

"/            ]

        ].

        checkinInfo := self 

                        getCheckinInfoFor:aClass name 

                        initialAnswer:initialLog.

        checkinInfo isNil ifTrue:[^ false].

        logMessage := checkinInfo logMessage.

    ] ifFalse:[

        aLogMessageOrNil isString ifTrue:[

            logMessage := aLogMessageOrNil

        ] ifFalse:[ 

            checkinInfo := aLogMessageOrNil.

            logMessage := checkinInfo logMessage.

        ].

    ].

    resources := self classResources.

    info := mgr sourceInfoOfClass:aClass.

    (info isNil 

    or:[(info at:#fileName ifAbsent:nil) isNil

    or:[(info at:#module ifAbsent:nil) isNil

    or:[(info at:#directory ifAbsent:nil) isNil]]]) ifTrue:[

        (self createSourceContainerForClass:aClass) 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:[ 

            "/ mhmh - check if it has a container.

            (mgr checkForExistingContainerForClass:aClass) ifFalse:[

                (self createSourceContainerForClass:aClass) ifFalse:[

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

                    ^ false.

                ] ifTrue:[

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

                (mgr checkinClass:aClass logMessage:logMessage) ifFalse:[

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

                    self warn:'checkin of ''' , aClass name allBold , ''' failed'.

                    ^ false.

                ].

                (checkinInfo notNil and:[checkinInfo isStable]) ifTrue:[

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

                    mgr setSymbolicName:#stable 

                        revision:nil 

                        overWrite:true 

                        path:((mgr sourceInfoOfClass:aClass) at:#pathInRepository).

                ].

            ].

            aborted ifTrue:[

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

                AbortAllOperationRequest isHandled ifTrue:[

                    (Dialog 

                        confirm:(resources stringWithCRs:'Checkin of ''' , aClass name , ''' aborted.\\Cancel all ?')

                        default:false)

                    ifTrue:[

                        AbortAllOperationRequest raise.

                    ]

                ].

                ^ false.

            ].

        ].

    ].

    ^ true

    "Modified: / 16.11.2001 / 17:39:21 / cg"

!

checkinClasses:aCollectionOfClass

    "check a collection of classes into the source repository.

     Asks interactively for log-message."

    ^ self checkinClasses:aCollectionOfClass withLog:nil

!

checkinClasses:aCollectionOfClasses withLog:aLogMessageOrNil

    "check a bunch of classes into the source repository.

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

    ^ self

        checkinClasses:aCollectionOfClasses 

        withLog:aLogMessageOrNil 

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

!

checkinClasses:aCollectionOfClasses withLog:aLogMessageOrNil withCheck:doCheckClasses

    "check a bunch of classes into the source repository.

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

    |classes checkinInfo resources yesOrNoToAll|

    "/ 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 withLog:aLogMessageOrNil withCheck:doCheckClasses.

    ].

    resources := self classResources.

    aLogMessageOrNil isNil ifTrue:[

        checkinInfo := SourceCodeManagerUtilities 

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

                        initialAnswer:nil.

        checkinInfo isNil ifTrue:[

            ^ self

        ].

    ] ifFalse:[

        checkinInfo := aLogMessageOrNil.

    ].

    AbortAllOperationRequest handle:[:ex |

        ex return

    ] do:[

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

                        ] do:[

                            self checkinClass:aClass withLog:checkinInfo withCheck:doCheckClasses

                        ]

                    ].

                ]

            ]

        ].

    ].

!

checkinExtensionMethods:aCollectionOfMethods forPackage:aPackageID withLog:aLogMessageOrNil

    "checkin a projects extensions into the source repository.

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

    |logMessage checkinInfo mgr pri resources module package i containerFileName s 

     methodSource methodsSortedByName|

    resources := self classResources.

    mgr := aCollectionOfMethods first mclass theNonMetaclass sourceCodeManager.

    mgr isNil ifTrue:[

        self warn:'No sourceCode manager defined - cannot checkin.'.

"/        self error:'No sourceCode manager defined' mayProceed:true.

        ^  false.

    ].

    i := aPackageID indexOf:$:.

    i == 0 ifTrue:[