"

 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.

"

Object subclass:#SourceCodeManagerUtilities

	instanceVariableNames:''

	classVariableNames:'LastSourceLogMessage LastModule LastPackage'

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

askForContainer:boxText title:title note:notice initialModule:initialModule initialPackage:initialPackage initialFileName:initialFileName

    "open a dialog asking for a source container;

     return a dictionary containing module, package and filename,

     or nil if canceled."

    |box y component resources 

     moduleHolder packageHolder fileNameHolder

     module package fileName|

    moduleHolder := initialModule asValue.

    packageHolder := initialPackage asValue.

    fileNameHolder := initialFileName asValue.

    resources := ResourcePack for:self.

    "/

    "/ open a dialog for this

    "/

    box := DialogBox new.

    box label:title.

    component := box addTextLabel:boxText withCRs.

    component adjust:#left; borderWidth:0.

    box addVerticalSpace.

    box addVerticalSpace.

    y := box yPosition.

    component := box addTextLabel:(resources string:'Module:').

    component width:0.4; adjust:#right.

    box yPosition:y.

    component := box addInputFieldOn:moduleHolder tabable:true.

    component width:0.6; left:0.4; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.

    box addVerticalSpace.

    y := box yPosition.

    component := box addTextLabel:'Package:'.

    component width:0.4; adjust:#right.

    box yPosition:y.

    component := box addInputFieldOn:packageHolder tabable:true.

    component width:0.6; left:0.4; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.

    box addVerticalSpace.

    y := box yPosition.

    component := box addTextLabel:'Filename:'.

    component width:0.4; adjust:#right.

    box yPosition:y.

    component := box addInputFieldOn:fileNameHolder tabable:true.

    component width:0.6; left:0.4; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.

    box addVerticalSpace.

    notice notNil ifTrue:[

        component := box addTextLabel:notice.

        component adjust:#left; borderWidth:0.

    ].

    box addVerticalSpace.

    box addAbortAndOkButtons.

    box showAtPointer.

    box accepted ifFalse:[

        box destroy.

        ^ nil

    ].

    box destroy.

    module := moduleHolder value withoutSpaces.

    package := packageHolder value withoutSpaces.

    fileName := fileNameHolder value withoutSpaces.

    ^ Dictionary new

        at:#module put:module;

        at:#package put:package;

        at:#fileName put:fileName;

        yourself

    "

     self 

        askForContainer:'enter container' title:'container' note:'some note'

        initialModule:'foo' initialPackage:'bar' initialFileName:'baz'        

    "

!

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

    |logMessage info mgr pri resources|

    aClass isLoaded ifFalse:[

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

        ^ false.

    ].

    aLogMessageOrNil isNil ifTrue:[

        logMessage isNil ifTrue:[^ self].

    ] ifFalse:[

        logMessage := aLogMessageOrNil

    ].

    resources := ResourcePack for:self.

    mgr := (aClass sourceCodeManager).

    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 a container for ''' , aClass name , ''''.

                ] ifTrue:[

                    freshCreated := true.

                ].

            ]

        ].

        freshCreated ifFalse:[

            aborted := false.

            Object abortSignal handle:[:ex |

                aborted := true.

                ex return.

                ^ false.

            ] do:[

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

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

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

                    ^ false.

                ].

            ].

            aborted ifTrue:[

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

                self warn:'checkin of ''' , aClass name , ''' aborted'.

                ^ false.

            ].

        ].

    ].

    ^ true

!

    "check a collection of classes into the source repository.

     Asks interactively for log-message."

!

checkinClasses:aCollectionOfClasses withLog:aLogMessageOrNil

    "check a bunch of classes into the source repository.

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

    |classes logMessage resources|

    resources := ResourcePack for:self.

    (logMessage := aLogMessageOrNil) isNil ifTrue:[

        logMessage := SourceCodeManagerUtilities getLogMessageFor:(resources string:'classes to checkin').

    ].

    classes do:[:aClass |

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

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

        InformationSignal handle:[:ex |

            Transcript showCR:ex errorString

        ] do:[

            self checkinClass:aClass withLog:logMessage

        ].

    ]

!

createSourceContainerForClass:aClass

    "let user specify the source-repository values for aClass"

    |resources|

    resources := ResourcePack for:self.

    ^ self 

        defineSourceContainerForClass:aClass 

        title:(resources string:'Repository information for %1' with:aClass name)

        text:(resources string:'CREATE_REPOSITORY' with:aClass name)

        createDirectories:true

        createContainer:true.

!

defineSourceContainerForClass:aClass title:title text:boxText createDirectories:createDirs createContainer:createContainer

    "let user specify the source-repository values for aClass"

    |box className

     oldModule oldPackage oldFileName

     module package fileName nameSpace nameSpacePrefix

     y component info project nm mgr creatingNew msg 

     answer doCheckinWithoutAsking forceCheckIn resources rslt note|

    resources := ResourcePack for:self.

    aClass isLoaded ifFalse:[

        self warn:'please load the class first'.

        ^ false.

    ].

    className := aClass name.

    "/

    "/ defaults, if nothing at all is known

    "/

    (module := LastModule) isNil ifTrue:[

        module := (OperatingSystem getLoginName).

    ].

    (package := LastPackage) isNil ifTrue:[

        package := 'private'.

    ].

    "/

    "/ try to extract some useful defaults from the current project

    "/

    (Project notNil and:[(project := Project current) notNil]) ifTrue:[

        package isNil ifTrue:[

            (nm := project repositoryDirectory) isNil ifTrue:[

                nm := project name

            ].

            package := nm.

        ].

        module isNil ifTrue:[

            (nm := project repositoryModule) notNil ifTrue:[

                module := nm

            ]

        ].

    ].

    "/

    "/ ask the sourceCodeManager if it knows anything about that class

    "/ if so, take that as a default.

    "/

    info := (mgr := aClass sourceCodeManager) sourceInfoOfClass:aClass.

    info notNil ifTrue:[

        module ~= LastModule ifTrue:[

            (info includesKey:#module) ifTrue:[

                module := (info at:#module).

            ].

        ].

        package ~= LastPackage ifTrue:[

            (info includesKey:#directory) ifTrue:[

                package := (info at:#directory).

            ].

        ].

        fileName := mgr containerFromSourceInfo:info.

        (nameSpace := aClass nameSpace) ~~ Smalltalk ifTrue:[

            nameSpacePrefix := nameSpace name , '::'.

            (fileName startsWith:nameSpacePrefix) ifTrue:[

                fileName := fileName copyFrom:(nameSpacePrefix size + 1).

            ]

        ].

"/        (info includesKey:#fileName) ifTrue:[

"/            fileName := (info at:#fileName).

"/        ] ifFalse:[

"/            (info includesKey:#expectedFileName) ifTrue:[

"/                fileName := (info at:#expectedFileName).

"/            ] ifFalse:[

"/                (info includesKey:#classFileNameBase) ifTrue:[

"/                    fileName := (info at:#classFileNameBase) , '.st'.

"/                ]

"/            ]

"/        ]

    ].

    fileName isNil ifTrue:[

        aClass nameSpace ~~ Smalltalk ifTrue:[

             fileName := aClass nameWithoutPrefix , '.st'.

        ] ifFalse:[

             fileName := (Smalltalk fileNameForClass:aClass) , '.st'.

        ]

    ].

    OperatingSystem isMSDOSlike ifTrue:[

        module replaceAll:$\ with:$/.

    ].

    OperatingSystem isMSDOSlike ifTrue:[

        package replaceAll:$\ with:$/.

    ].

    "/

    "/ check for conflicts (i.e. if such a container already exists) ...

    "/

    doCheckinWithoutAsking := false.

    (mgr checkForExistingContainerInModule:module 

                                   package:package 

                                 container:fileName) ifTrue:[

        answer := Dialog confirmWithCancel:(resources 

                            string:'About to change the source container.

Notice: there is a container for %1 in:

    %2 / %3 / %4

Do you want to change it or check right into that container ?'

                            with:className

                            with:module

                            with:package

                            with:fileName)

                labels:(resources array:#('cancel' 'check in' 'change')).

        answer isNil ifTrue:[AbortSignal raise].

        answer ifTrue:[

            doCheckinWithoutAsking := false.

            oldModule := module.

            oldPackage := package.

            oldFileName := fileName

        ] ifFalse:[

            doCheckinWithoutAsking := true.

            creatingNew := false.

        ].

    ].

    doCheckinWithoutAsking ifFalse:[

        "/

        "/ open a dialog for this

        "/

        (mgr checkForExistingContainerInModule:module 

                                       package:package 

                                     container:fileName) ifFalse:[

            note := 'Notice: class seems to have no container yet.'.

            creatingNew := true.

        ] ifTrue:[

            creatingNew := false.

        ].

        rslt := self 

                askForContainer:boxText title:title note:note

                initialModule:module initialPackage:package initialFileName:fileName.        

        rslt isNil ifTrue:[

            ^ false

        ].

        module := rslt at:#module.

        package := rslt at:#package.

        fileName := rslt at:#fileName.

    ].

    (fileName endsWith:',v') ifTrue:[

        fileName := fileName copyWithoutLast:2

    ].

    (fileName endsWith:'.st') ifFalse:[

        fileName := fileName , '.st'

    ].

    info := aClass revisionInfo.

    info notNil ifTrue:[

        (info includesKey:#repositoryPathName) ifFalse:[

            info := nil

        ]

    ].

    info isNil ifTrue:[

        creatingNew ifFalse:[

            doCheckinWithoutAsking ifFalse:[

                (Dialog 

                    confirm:(resources string:'The repository already contains a container named "%3" in "%1/%2" !!\\Checkin %4 anyway ? (DANGER - be careful)'

                         withArgs:(Array with:module with:package with:fileName with:className)) withCRs

                    noLabel:'cancel')

                ifFalse:[

                    ^ false

                ].

            ]

        ].

        doCheckinWithoutAsking ifFalse:[

            (Dialog 

                confirm:(resources string:'%1 does not have any (usable) revision info (#version method)\\Shall I create one ?' with:className) withCRs

                noLabel:'cancel')

            ifFalse:[

                ^ false

            ].

        ].

        aClass updateVersionMethodFor:(mgr initialRevisionStringFor:aClass 

                                           inModule:module 

                                           package:package 

                                           container:fileName).

    ].

    "/

    "/ check for the module

    "/

    (mgr checkForExistingModule:module) ifFalse:[

        (createDirs or:[creatingNew]) ifFalse:[

            self warn:(resources string:'a module named %1 does not exist in the source code management' with:module).

            ^ false

        ].

        (Dialog 

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

            noLabel:'cancel') 

        ifFalse:[

            ^ false.

        ].

        (mgr createModule:module) ifFalse:[

            self warn:(resources string:'cannot create new module: %1' with:module).

            ^ false.

        ]

    ].

    LastModule := module.