"

 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'

!

!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

! !

!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 string:'A module named ''%1'' does not exist in the repository' 

                                  with:moduleName) withCRs.

            ^ false

        ].

        (Dialog 

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

            noLabel:'Cancel') 

        ifFalse:[

            ^ false.

        ].

        (mgr createModule:module) ifFalse:[

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

            ^ 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."

    |logMessage 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'

"/            ]

        ].

        logMessage := self 

                        getLogMessageFor:aClass name 

                        initialAnswer:initialLog.

        logMessage isNil ifTrue:[^ false].

    ] ifFalse:[

        logMessage := aLogMessageOrNil

    ].

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

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

            (self checkAndWarnAboutBadMessagesInClass:aClass) 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.

                ].

            ].

            aborted ifTrue:[

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

                AbortAllSignal isHandled ifTrue:[

                    (Dialog 

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

                        default:false)

                    ifTrue:[

                        AbortAllSignal 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 logMessage 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.

    (logMessage := aLogMessageOrNil) isNil ifTrue:[

        logMessage := SourceCodeManagerUtilities getLogMessageFor:(resources string:'%1 classes to checkin' with:aCollectionOfClasses size).

        logMessage isNil ifTrue:[

            ^ self

        ].

    ].

    AbortAllSignal 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

                    ] do:[

                        AbortSignal handle:[:ex |

                        ] do:[

                            self checkinClass:aClass withLog:logMessage 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 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:[

        self warn:'Cannot extract module/package from the packageID (invalid format)\\Please change the packageID to be of the form <module>:<subdirectory>,\and try again.\Or, alternatively, move the extensions to their classes project and checkIn the class(es).' withCRs.

"/        self error:'cannot extract module/package from packageID' mayProceed:true.

        ^  false.

    ].

    module := aPackageID copyTo:i-1.

    package := aPackageID copyFrom:i+1.

    (package startsWith:$:) ifTrue:[

        package := package copyFrom:2.

    ].

    containerFileName := 'extensions.st'.

    aLogMessageOrNil isNil ifTrue:[

        logMessage := SourceCodeManagerUtilities getLogMessageFor:containerFileName allBold.

        logMessage isNil ifTrue:[^ false].

    ] ifFalse:[

        logMessage := aLogMessageOrNil

    ].

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

    LastModule := module.

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

    LastPackage := package.

    (self checkForExistingModule:module package:package container:containerFileName using: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:[

        s := '' writeStream.

        s nextPutAll:'"{ Package: '''.

        s nextPutAll:aPackageID asString.

        s nextPutAll:''' }"'; cr; nextPutChunkSeparator; cr; cr.