"

 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'

	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 

     knownContainers knownPackages packageUpdater

     packageBoxComponent|

    knownContainers := Set new.

    Smalltalk allClassesDo:[:cls | |pckg|

        pckg := cls package.

        pckg size > 0 ifTrue:[

            knownContainers add:(pckg upTo:$:)

        ]

    ].

    knownContainers := knownContainers asOrderedCollection.

    knownContainers := knownContainers select:[:module | module isBlank not].

    knownContainers sort.

    packageUpdater := [

        |theModulePrefix|

        theModulePrefix := moduleHolder value , ':'.

        knownPackages := Set new.

        Smalltalk allClassesDo:[:cls | |pckg idx|

            pckg := cls package.

            pckg size > 0 ifTrue:[

                (pckg startsWith:theModulePrefix) ifTrue:[

                    idx := pckg indexOf:$:.

                    knownPackages add:(pckg copyFrom:idx + 1)

                ]

            ]

        ].

        knownPackages := knownPackages asOrderedCollection.

        knownPackages := knownPackages select:[:package | package isBlank not].

        knownPackages sort.

        packageBoxComponent list:knownPackages.

    ].

    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 addComboBoxOn:moduleHolder tabable:true.

    component list:knownContainers.

"/    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:(resources string:'Package:').

    component width:0.4; adjust:#right.

    box yPosition:y.

    packageBoxComponent := component := box addComboBoxOn:packageHolder tabable:true.

"/    component := box addInputFieldOn:packageHolder tabable:true.

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

    packageUpdater value.

    moduleHolder onChangeEvaluate:packageUpdater.

    box addVerticalSpace.

    y := box yPosition.

    component := box addTextLabel:(resources string:'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'        

    "

!

askForExistingRevision:boxText title:title class:aClass

    "open a dialog asking for a containers revision;

     return a revision number, or nil if canceled."

    |mgr sourceInfo module package fileName|

    mgr := aClass sourceCodeManager.

    sourceInfo := mgr sourceInfoOfClass:aClass.

    sourceInfo isNil ifTrue:[^ nil].

    package := mgr packageFromSourceInfo:sourceInfo.

    module := mgr moduleFromSourceInfo:sourceInfo.  

    fileName := mgr containerFromSourceInfo:sourceInfo.

    ^ self

        askForExistingRevision:boxText 

        title:title 

        class:aClass 

        manager:mgr 

        module:module package:package fileName:fileName

    "

     SourceCodeManagerUtilities

        askForRevisionToCompare:'enter revision'

        title:'revision'

        class:Array

    "

!

askForExistingRevision:boxText title:title class:clsOrNil manager:aSourceCodeManager module:module package:package fileName:fileName

    "open a dialog asking for a containers revision;

     return a revision number, or nil if canceled."

    |partialLog revisions items newestRev

     box y component resources 

     revisionHolder|

    partialLog := aSourceCodeManager

        revisionLogOf:clsOrNil

        numberOfRevisions:20

        fileName:fileName

        directory:package 

        module:module.

    partialLog notNil ifTrue:[

        newestRev := partialLog at:#newestRevision.

        revisions := partialLog at:#revisions.

        items := revisions collect:[:each | |rev date who|

                                        rev := each at:#revision.

                                        date := each at:#date.

                                        who := each at:#author.

                                        rev asText allBold , ' [' , date , ' by ' , who , ']'

                                   ].

        revisions := revisions collect:[:each | each at:#revision].

    ] ifFalse:[

        newestRev := aSourceCodeManager newestRevisionInFile:fileName directory:package module:module.

        revisions := items := nil.

    ].

    revisionHolder  := newestRev asValue.

    resources := ResourcePack for:self.

    revisionHolder onChangeEvaluate:[

        "/ cut off everything after revision

        |s first words|

        s := revisionHolder value.

        words := s asCollectionOfWords.

        words size > 0 ifTrue:[

            first := words first string.

            first ~= s ifTrue:[

                revisionHolder value:first

            ]

        ]

    ].

    "/

    "/ 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:'Revision:').

    component width:0.4; adjust:#right.

    box yPosition:y.

    component := box addComboBoxOn:revisionHolder tabable:true.

    component list:items.

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

    box addVerticalSpace.

    box addAbortAndOkButtons.

    box showAtPointer.

    box accepted ifFalse:[

        box destroy.

        ^ nil

    ].

    box destroy.

    ^ revisionHolder value withoutSpaces.

    "

     SourceCodeManagerUtilities

        askForRevisionToCompare:'enter revision'

        title:'revision'

        class:nil

        manager:SourceCodeManager 

        module:'stx'

        package:'libbasic'

        fileName:'Array.st'

    "

!

checkAndWarnAboutBadMessagesInClass:aClass

    "check if a class contains message-sends to:

        #halt

        #error

        (and maybe more in the future)"

    |badStuff whatIsBad msg|

    badStuff := #(

        ( #halt         'sent of #halt without descriptive message - better use halt:''some message''' )

        ( #error        'sent of #error without descriptive message - better use error:''some message''' )

    ).

    whatIsBad := Set new.

    aClass theNonMetaclass allSelectorsAndMethodsDo:[:sel :mthd |

        |setOfSentMessages|

        setOfSentMessages := mthd messagesSent.

        badStuff do:[:eachEntry |

            (setOfSentMessages includes:eachEntry first) ifTrue:[

                whatIsBad add:eachEntry second

            ]

        ].

    ].

    whatIsBad notEmpty ifTrue:[

        msg := 'Your class contains the following  (considered bad style) message sends:\\'.

        whatIsBad do:[:each |

            msg := msg , '   ' , each , '\'

        ].

        msg := msg , '\\' , 'Do you really want to check in this class ?'.

        ^ self confirm:msg withCRs

    ].

    ^ true.

    "

     self checkAndWarnAboutBadMessagesInClass:(SourceCodeManagerUtilities)  

    "

!

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|

    aClass isLoaded ifFalse:[

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

        ^ false.

    ].

    mgr := (aClass sourceCodeManager).

    mgr isNil ifTrue:[

        self halt:'oops'.

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

            ^ false

        ].

        mgr := CVSSourceCodeManager.

    ].

    aLogMessageOrNil isNil ifTrue:[

        logMessage := SourceCodeManagerUtilities getLogMessageFor:aClass name asText allBold.

        logMessage isNil ifTrue:[^ self].

    ] ifFalse:[

        logMessage := aLogMessageOrNil

    ].

    resources := ResourcePack for:self.

    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.

                ].

            ]

        ].

        doCheckClass ifTrue:[

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

            (self checkAndWarnAboutBadMessagesInClass:aClass) ifFalse:[

                ^ false

            ].

        ].

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

    |classes logMessage resources|

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

    ].

    resources := ResourcePack for:self.

    (logMessage := aLogMessageOrNil) isNil ifTrue:[

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

        logMessage isNil ifTrue:[

            ^ self

        ].

    ].

    classes do:[:aClass |

        (self checkAndWarnAboutBadMessagesInClass:aClass) ifTrue:[

            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

            ].

        ].

    ]

!