"

 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:'resources'!

resourcePackage

    ^ #'stx:libtool'

! !

!SourceCodeManagerUtilities class methodsFor:'utilities'!

classIsNotYetInRepository:aClass withManager:mgr

    |info|

    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]]])

    "Created: / 25-10-2006 / 09:43:00 / cg"

!

nameOfExtensionsContainer

    ^ 'extensions.st'

!

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 theNonMetaclass 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

    "Modified: / 12-09-2006 / 14:14:35 / cg"

!

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

changeSetForExtensionMethodsForPackage:packageToCheckOut askForRevision:askForRevision using:aSourceCodeManager

    "check-out an extension container from the source repository, and return the methods there as a change set.

     If askForRevision is false, check-out the newest version.

     Return a changeSet or nil (if any error occurred)"

    |resources directory module file

     inChangeSet extensionMethods

     aStream sourceToLoad rev msg newestRev

     listHere listRep diffSet 

     changed onlyHere onlyInRep answer labels values singleChangeSelector

     changedClasses default |

    resources := self classResources.

    directory := packageToCheckOut asPackageId directory.

    module := packageToCheckOut asPackageId module.

    file := self nameOfExtensionsContainer.

    "/

    "/ ask for revision

    "/

    newestRev := aSourceCodeManager newestRevisionInFile:file directory:directory module:module.

    askForRevision ifFalse:[

        rev := newestRev ? ''

    ] ifTrue:[

        msg := resources string:'CheckOut which revision of extensions for ''%1'': (empty for newest)' with:packageToCheckOut allBold.

        newestRev notNil ifTrue:[

            msg := msg , '\' , (resources string:'Newest in reporitory is %1.' with:newestRev)

        ].

        rev := SourceCodeManagerUtilities

                askForExistingRevision:msg 

                title:'CheckOut from repository' 

                class:nil 

                manager:aSourceCodeManager 

                module:module package:directory fileName:file.

        rev isNil ifTrue:[

            ^ nil   "/ canceled

        ].

    ].

    rev withoutSpaces isEmpty ifTrue:[

        rev := #newest.

        msg := 'extracting newest %1 (' , (newestRev ? '???') , ')'.

    ] ifFalse:[

        msg := 'extracting previous %1'.

    ].

    aStream := aSourceCodeManager  

        streamForClass:nil

        fileName:file 

        revision:rev 

        directory:directory 

        module:module

        cache:true.

    aStream isNil ifTrue:[

        self warn:(resources string:'Could not extract "extensions.st" for %1 from repository' with:packageToCheckOut allBold).

        ^ nil

    ].

    aStream class readErrorSignal handle:[:ex |

        self warn:('read error while reading extracted source\\' , ex description) withCRs.

        aStream close.

        ^ nil

    ] do:[

        sourceToLoad := aStream contents asString.

    ].

    aStream close.

    ^ ChangeSet fromStream:(sourceToLoad readStream).

    "Created: / 09-10-2006 / 13:04:37 / cg"

!

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

    |resources moduleName directoryName containerName|

    resources := self classResources.

    moduleName := module allBold.

    directoryName := directory allBold.

    containerName := containerFileName allBold.

    "/

    "/ check for the container

    "/

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

        allowCreate ifFalse:[

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

                                   with:containerName with:moduleName with:directoryName) withCRs.

            ^ false

        ].

        (Dialog 

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

                                 with:containerName with:moduleName with:directoryName) withCRs

            noLabel:'Cancel') 

        ifFalse:[

            ^ false.

        ].

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

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

                                 with:containerName with:moduleName with:directoryName).

            ^ false.

        ]

    ].

    ^ true.

    "Modified: / 13-09-2006 / 18:24:57 / cg"

!

checkForExistingModule:module directory:directory using:mgr allowCreate:allowCreate

    |resources moduleNameBold directoryNameBold|

    resources := self classResources.

    moduleNameBold := module allBold.

    directoryNameBold := directory allBold.

    "/

    "/ check for the directory

    "/

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

        allowCreate ifFalse:[

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

                                   with:directoryNameBold with:moduleNameBold) withCRs.

            ^ false

        ].

        (Dialog 

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

                                 with:directoryNameBold with:moduleNameBold) withCRs

            noLabel:'Cancel') 

        ifFalse:[

            ^ false.

        ].

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

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

                                   with:directoryNameBold with:moduleNameBold) withCRs.

            ^ false.

        ]

    ].

    ^ true.

    "Modified: / 06-10-2006 / 17:08:08 / cg"

!

checkForExistingModule:module using:mgr allowCreate:allowCreate

    |resources moduleName answer|

    (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

        ].

        AbortAllOperationRequest isHandled ifTrue:[

            answer := Dialog 

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

                labels:(resources array:#('Cancel All' 'Cancel' 'Yes' )).

            answer isNil ifTrue:[ AbortAllOperationRequest raise ].

        ] ifFalse:[

            answer := Dialog 

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

                noLabel:'Cancel'

        ].

        answer 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 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:aLogInfoNil withCheck:doCheckClass

    "check a class into the source repository.

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

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

    |logMessage checkinInfo mgr pri resources selectorsInChangeSet initialLog|

    aClass isLoaded ifFalse:[

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

        ^ false.

    ].

    mgr := self sourceCodeManagerFor:aClass.

    mgr isNil ifTrue:[

        ^ false

    ].

    aLogInfoNil isNil ifTrue:[

        selectorsInChangeSet := ChangeSet current 

                                    select:[:aChange | aChange isMethodChange and:[aChange className = aClass name]]

                                    thenCollect:[:aChange | aChange selector].

        selectorsInChangeSet size == 1 ifTrue:[

            initialLog := 'changed ',selectorsInChangeSet first storeString.

        ].

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

        aLogInfoNil isString ifTrue:[

            "soon obsolete..."    

            logMessage := aLogInfoNil

        ] ifFalse:[ 

            checkinInfo := aLogInfoNil.

            logMessage := checkinInfo logMessage.

        ].

    ].

    resources := self classResources.

    (self classIsNotYetInRepository:aClass withManager:mgr) 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.

                ].

                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].

                checkinState ifFalse:[

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

                    self warn:'checkin of ''' , aClass name allBold , ''' failed - ', 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:[  |con|

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

                AbortAllOperationRequest isHandled ifTrue:[

                    (Dialog 

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