Object subclass:#SourceCodeManagerUtilities

!

!SourceCodeManagerUtilities class methodsFor:'documentation'!

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

    ^ self checkinClass:aClass withLog:nil

!

checkinClass:aClass withLog:aLogMessageOrNil

    |logMessage info mgr pri resources|

    aClass isLoaded ifFalse:[

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

        ^ false.

    ].

    aLogMessageOrNil isNil ifTrue:[

        logMessage := SourceCodeManagerUtilities getLogMessageFor:aClass name.

        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

!

checkinClasses:aCollectionOfClasses withLog:aLogMessageOrNil

    |classes logMessage resources|

    resources := ResourcePack for:self.

    (logMessage := aLogMessageOrNil) isNil ifTrue:[

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

    ].

    "/ ignore private classes

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

    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

     moduleHolder packageHolder fileNameHolder

     oldModule oldPackage oldFileName

     module package fileName nameSpace nameSpacePrefix

     y component info project nm mgr creatingNew msg 

     answer doCheckinWithoutAsking forceCheckIn resources|

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

        ]

    ].

    fileNameHolder := fileName asValue.

    OperatingSystem isMSDOSlike ifTrue:[

        module replaceAll:$\ with:$/.

    ].

    moduleHolder := module asValue.

    OperatingSystem isMSDOSlike ifTrue:[

        package replaceAll:$\ with:$/.

    ].

    packageHolder := package asValue.

    "/

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

        "/

        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.

        (mgr checkForExistingContainerInModule:module 

                                       package:package 

                                     container:fileName) ifFalse:[

            component := box addTextLabel:'Notice: class seems to have no container yet.'.

            component adjust:#left; borderWidth:0.

            creatingNew := true.

        ] ifTrue:[

            creatingNew := false.

        ].

        box addVerticalSpace.

        box addAbortAndOkButtons.

        box showAtPointer.

        box accepted ifFalse:[

            box destroy.

            ^ false

        ].

        module := moduleHolder value withoutSpaces.

        package := packageHolder value withoutSpaces.

        fileName := fileNameHolder value withoutSpaces.

    ].

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

    "/

    "/ check for the package

    "/

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

        (createDirs or:[creatingNew]) ifFalse:[

            self warn:(resources string:'a package named %1 does not exist module %2' with:module with:package).

            ^ false

        ].

        (Dialog 

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

            noLabel:'cancel') 

        ifFalse:[

            ^ false.

        ].

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

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

            ^ false.

        ]

    ].

    LastPackage := package.

    "/

    "/ check for the container itself

    "/

    (mgr checkForExistingContainerInModule:module package:package container:fileName) ifTrue:[

        creatingNew ifTrue:[

            self warn:(resources string:'container for %1 already exists in %2/%3.' with:fileName with:module with:package) withCRs.

        ].

"/            (oldModule notNil

"/            and:[(oldModule ~= module)

"/                 or:[oldPackage ~= package

"/                 or:[oldFileName ~= fileName]]])

"/            ifFalse:[

"/                self warn:(resources string:'no change').

"/                ^ false.

"/            ].

        doCheckinWithoutAsking ifFalse:[

            (Dialog 

                confirm:(resources string:'check %1 into the existing container

    %2 / %3 / %4  ?'

                                with:className

                                with:module 

                                with:package 

                                with:fileName) withCRs

                noLabel:'cancel') 

            ifFalse:[

                ^ false.

            ].  

        ].  

        aClass updateVersionMethodFor:'$' , 'Header' , '$'. "/ concatenated to avoid RCS-expansion

        oldFileName notNil ifTrue:[

            msg := ('forced checkin / source container change from ' , oldFileName).

        ] ifFalse:[

            msg := 'defined source container'

        ].

        (forceCheckIn := doCheckinWithoutAsking) ifFalse:[

            (mgr

                checkinClass:aClass 

                fileName:fileName 

                directory:package 

                module:module 

                logMessage:msg)

            ifFalse:[

                doCheckinWithoutAsking ifFalse:[

                    (Dialog 

                        confirm:'no easy merge seems possible; force checkin (no merge) ?'

                        noLabel:'cancel') 

                    ifFalse:[

                        ^ false.

                    ].

                ].

                forceCheckIn := true.