"

 COPYRIGHT (c) 1995 by Claus Gittinger

	      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:#AbstractSourceCodeManager

	instanceVariableNames:''

	classVariableNames:'DefaultManager CachingSources CacheDirectoryName UseWorkTree

		WorkTreeDirectoryName'

	poolDictionaries:''

	category:'System-SourceCodeManagement'

!

!AbstractSourceCodeManager class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1995 by Claus Gittinger

	      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

"

    Abstract superclass for sourceCodeManagers.

    Concrete subclasses provide access to a source repository.

    All protocol here traps into subclassResponsbility errors.

    Please read more documentation in concrete subclasses 

    (especially: CVSSourceCodeManager) for how to use this manager.

    [author:]

        Claus Gittinger

"

! !

!AbstractSourceCodeManager class methodsFor:'initialization'!

initCacheDirPath

    "initialize the name of the cacheDirectory.

     This is:

          <tempDir>/stx_sourceCache."

    CacheDirectoryName := (Filename tempDirectory constructString:'stx_sourceCache').

    "

     self initCacheDirPath

    "

    "Modified: / 12.7.1999 / 10:01:31 / cg"

!

initialize

    "setup for no caching and no workTree"

    CachingSources ifNil:[CachingSources := false].

    UseWorkTree    ifNil:[UseWorkTree := false].

! !

!AbstractSourceCodeManager class methodsFor:'accessing'!

cacheDirectoryName

    "return the name of the cache directory, where checked out class

     sources are kept for faster access. The default is '/tmp/stx_sourceCache'.

     This cache is shared among all ST/X users on a system."

    ^ CacheDirectoryName

    "Modified: 12.9.1996 / 02:20:45 / cg"

!

cacheDirectoryName:aStringOrFilename

    "set the name of the cache directory, where checked out class

     sources are kept for faster access. The default is '/tmp/stx_sourceCache'.

     This cache is shared among all ST/X users on a system.

     The directory is typically set via the launchers setting menu, or

     from a startup rc-file."

    CacheDirectoryName := aStringOrFilename

    "Created: 16.12.1995 / 15:18:43 / cg"

    "Modified: 12.9.1996 / 02:21:35 / cg"

!

cachingSources

    "return true, if source caching is enabled.

     (see cacheDirectoryName for what that means)"

    ^ CachingSources

    "Created: 16.12.1995 / 15:17:50 / cg"

    "Modified: 12.9.1996 / 02:22:19 / cg"

!

cachingSources:aBoolean

    "enable/disable the caching of source files.

     (see cacheDirectoryName for what that means)"

    CachingSources := aBoolean

    "Created: 16.12.1995 / 15:18:13 / cg"

    "Modified: 12.9.1996 / 02:22:42 / cg"

!

defaultManager

    "return the default sourceCodeManager class"

    ^ DefaultManager

    "Created: 7.12.1995 / 17:14:22 / cg"

    "Modified: 12.9.1996 / 02:22:56 / cg"

!

repositoryName

    "return the name of the repository.

     Since this is an abstract class, return nil (i.e. none)"

    ^ nil

    "Modified: 12.9.1996 / 02:20:45 / cg"

    "Created: 14.9.1996 / 13:21:37 / cg"

!

useWorkTree

    "return the setting of useWorkTree, which (eventually)

     controls if an up-to-date view of a CVS working tree should be

     kept in sync. This is not yet implemented."

    ^ UseWorkTree

    "Created: 16.12.1995 / 15:36:48 / cg"

    "Modified: 12.9.1996 / 02:24:01 / cg"

!

useWorkTree:aBoolean

    "enable/disable the useWorkTree feature, which (eventually)

     controls if an up-to-date view of a CVS working tree should be

     kept in sync. This is not yet implemented."

    UseWorkTree := aBoolean

    "Created: 16.12.1995 / 15:37:29 / cg"

    "Modified: 12.9.1996 / 02:24:38 / cg"

!

workTreeDirectoryName

    "return the name of the workTree, which is kept in sync

     with the current class versions. This is not yet implemented"

    ^ WorkTreeDirectoryName

    "Created: 16.12.1995 / 15:35:21 / cg"

    "Modified: 12.9.1996 / 02:25:13 / cg"

!

workTreeDirectoryName:aStringOrFilename

    "set the name of the workTree, which is kept in sync

     with the current class versions. This is not yet implemented"

    WorkTreeDirectoryName := aStringOrFilename

    "Created: 16.12.1995 / 15:35:34 / cg"

    "Modified: 12.9.1996 / 02:25:19 / cg"

! !

!AbstractSourceCodeManager class methodsFor:'basic access'!

checkinClass:aClass fileName:classFileName directory:packageDir module:moduleDir source:sourceFile logMessage:logMessage force:force

    "checkin of a class into the source repository.

     Return true if ok, false if not."

    ^ self subclassResponsibility.

    "Created: 14.2.1997 / 21:17:33 / cg"

    "Modified: 14.2.1997 / 21:18:48 / cg"

!

checkoutModule:aModule package:aPackage andDo:aBlock

    "check out everything from a package into a temporary directory.

     Then evaluate aBlock, passing the name of that temp-directory.

     Afterwards, the tempDir is removed.

     Return true, if OK, false if any error occurred."

    ^ self subclassResponsibility

    "Modified: 14.2.1997 / 21:18:35 / cg"

!

streamForClass:aClass fileName:classFileName revision:revision directory:packageDir module:moduleDir cache:doCache

    "extract a classes source code and return an open readStream on it.

     A revision of nil selects the current (in image) revision.

     The classes source code is extracted using the revision and the sourceCodeInfo,

     which itself is extracted from the classes packageString."

    ^ self subclassResponsibility

    "Modified: 14.2.1997 / 21:18:35 / cg"

! !

!AbstractSourceCodeManager class methodsFor:'basic administration'!

checkForExistingContainerForClass:aClass

    "check if a source-code container for a given class is present in the repository."

    |sourceInfo packageDir moduleDir classFileName|

    sourceInfo := self sourceInfoOfClass:aClass.

    sourceInfo isNil ifTrue:[

        ('SourceCodeManager [warning]: no sourceInfo for class: ' , aClass name) errorPrintCR.

        ^ false

    ].

    packageDir := self packageFromSourceInfo:sourceInfo.

    moduleDir := self moduleFromSourceInfo:sourceInfo.  "/ use the modules name as CVS module

    classFileName := self containerFromSourceInfo:sourceInfo.

    ^ self checkForExistingContainerInModule:moduleDir package:packageDir container:classFileName

    "Created: / 13.5.1998 / 22:35:50 / cg"

!

checkForExistingContainerInModule:moduleName package:dirName container:fileName

    "check for a container to be present"

    ^ self subclassResponsibility.

    "Created: 9.12.1995 / 19:02:23 / cg"

    "Modified: 14.2.1997 / 21:18:56 / cg"

!

checkForExistingModule:moduleName

    "check for a module directory to be present"

    ^ self subclassResponsibility.

    "Created: 9.12.1995 / 19:02:23 / cg"

    "Modified: 14.2.1997 / 21:19:01 / cg"

!

checkForExistingModule:moduleDir package:packageDir

    "check for a package directory to be present"

    ^ self subclassResponsibility.

    "Created: 9.12.1995 / 19:02:23 / cg"

    "Modified: 14.2.1997 / 21:19:06 / cg"

!

createContainerFor:aClass inModule:moduleName directory:dirName container:fileName

    "create a new container & check into it an initial version of aClass"

    ^ self subclassResponsibility.

    "Created: 9.12.1995 / 19:02:47 / cg"

    "Modified: 14.2.1997 / 21:19:11 / cg"

!

createModule:moduleName

    "create a new module directory"

    ^ self subclassResponsibility.

    "Created: 9.12.1995 / 19:02:23 / cg"

    "Modified: 14.2.1997 / 21:19:16 / cg"

!

createModule:module package:package

    "create a new package directory"

    ^ self subclassResponsibility.

    "Created: 9.12.1995 / 19:02:23 / cg"

    "Modified: 14.2.1997 / 21:19:21 / cg"

!

initialRevisionStringFor:aClass inModule:moduleDir package:packageDir container:fileName

    "return a string usable as initial revision string"

    ^ self subclassResponsibility

    "Created: 14.2.1997 / 21:01:41 / cg"

!

removeContainerFor:aClass inModule:moduleName directory:dirName container:fileName

    "remove a container"

    ^ self subclassResponsibility.

    "Created: 11.9.1996 / 13:18:33 / cg"

    "Modified: 14.2.1997 / 21:19:28 / cg"

!

revisionLogOf:cls fromRevision:rev1 toRevision:rev2 fileName:classFileName directory:packageDir module:moduleDir 

    "actually do return a revisionLog. The main worker method.

     This must be implemented by a concrete source-code manager"

    ^ self subclassResponsibility.

    "Created: 15.11.1995 / 18:12:51 / cg"

    "Modified: 14.2.1997 / 21:14:01 / cg"

! !

!AbstractSourceCodeManager class methodsFor:'cache administration'!

condenseSourceCache

    "remove all cached old versions (i.e. leave the newest only)"

    |d allFiles newestVersions|

    CacheDirectoryName notNil ifTrue:[

        newestVersions := Dictionary new.

        d := CacheDirectoryName asFilename.

        allFiles := d directoryContents copy asSet.

        allFiles do:[:eachFile |

            |base vsnNumberString i prevVsnString prevVsnNumbers vsnNumbers vsnIsGreater|

            i := eachFile size.

            [i > 0 and:[(eachFile at:i) isDigit or:[(eachFile at:i) == $.]]] whileTrue:[ i := i - 1 ].

            vsnNumberString := eachFile copyFrom:i + 1.

            (eachFile at:i) == $_ ifTrue:[i := i - 1].

            base := eachFile copyTo:i.

            vsnNumberString notEmpty ifTrue:[

                (newestVersions includesKey:base) ifFalse:[

                    newestVersions at:base put:vsnNumberString.

                ] ifTrue:[

                    prevVsnString := newestVersions at:base.

                    prevVsnNumbers := (prevVsnString asCollectionOfSubstringsSeparatedBy:$.) collect:[:each | Number readFrom:each].

                    vsnNumbers := (vsnNumberString asCollectionOfSubstringsSeparatedBy:$.) collect:[:each | Number readFrom:each].

                    vsnIsGreater := false.

                    1 to:((vsnNumbers size) min:(prevVsnNumbers size)) doWithBreak:[:part :exit |

                        (vsnNumbers at:part) > (prevVsnNumbers at:part) ifTrue:[

                            vsnIsGreater := true.

                            exit value.

                        ].

                    ].

                    vsnIsGreater ifTrue:[

                        newestVersions at:base put:vsnNumberString

                    ]

                ].

            ].

        ].

        allFiles do:[:eachFile |

            |base vsnNumberString i prevVsnString prevVsnNumbers vsnNumbers vsnIsGreater|

            i := eachFile size.

            [i > 0 and:[(eachFile at:i) isDigit or:[(eachFile at:i) == $.]]] whileTrue:[ i := i - 1 ].

            vsnNumberString := eachFile copyFrom:i + 1.

            (eachFile at:i) == $_ ifTrue:[i := i - 1].

            base := eachFile copyTo:i.

            vsnNumberString isEmpty ifTrue:[

                (d construct:eachFile) remove

            ] ifFalse:[

                (vsnNumberString = (newestVersions at:base)) ifFalse:[

                    (d construct:eachFile) remove

                ]

            ]

        ].

    ]

!

flushSourceCache

    "remove all cached versions"

    |d|

    CacheDirectoryName notNil ifTrue:[

        d := CacheDirectoryName asFilename.

        d directoryContents copy do:[:eachFile |

            (d construct:eachFile) remove

        ]

    ]

! !

!AbstractSourceCodeManager class methodsFor:'private'!

checkMethodPackagesOf:aClass

    "check if aClass contains methods from another package;

     ask if these should be checked in with the class.

     Raises abortSignal if checkIn is to be suppressed.

     returns:

        #base   - only check in methods from the classes package

        #all    - check in all

     the old code looked for all extensions, and allowed them to be moved to the base-package.

     This was dangerous, as if one presses yes too quickly, extensions move to the base too easy.

     The new code only allows for extensions from the __NOPROJECT__ package to be moved.

     Extensions always remain extensions, and must be moved by an explicit method-menu action.

    "

    |checkInClassPackageOnly clsPackage otherPackages otherPackageNames methodsFromOtherPackages

     methodCategoriesInOtherPackages methodCategoryInOtherPackages

     msg answer isDefaultAnswer labels actions hasUnassignedExtensions

     unassignedMethods methodCategoriesWithUnassignedMethods methodCategoryWithUnassignedMethods 

     args|

    checkInClassPackageOnly := false.

    clsPackage := aClass package.

    otherPackages := Set new.

    methodsFromOtherPackages := OrderedCollection new.

    hasUnassignedExtensions := false.

    unassignedMethods := OrderedCollection new.

    methodCategoriesWithUnassignedMethods := Set new.

    methodCategoriesInOtherPackages := Set new.

    aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |

        |mthdPackage|

        (mthdPackage := mthd package) ~= clsPackage ifTrue:[

            mthdPackage == Project noProjectID ifTrue:[

                hasUnassignedExtensions := true.

                unassignedMethods add:mthd.        

                methodCategoriesWithUnassignedMethods add:(mthd category).

            ] ifFalse:[

                methodsFromOtherPackages add:mthd.

                otherPackages add:mthdPackage.

                methodCategoriesInOtherPackages add:(mthd category).

            ].

        ]

    ].

    hasUnassignedExtensions ifFalse:[

        aClass allPrivateClassesDo:[:eachPrivateClass |

            aClass setPackage:clsPackage.

            eachPrivateClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |

                mthd setPackage:clsPackage

            ]

        ].

        ^ #base

    ].

    otherPackages := otherPackages asOrderedCollection sort.

    otherPackageNames := String streamContents:[:stream| 

        otherPackages 

            do:[:eachPackageName| eachPackageName printOn:stream] 

            separatedBy:[stream nextPutAll:', '].

    ].

    methodCategoriesInOtherPackages size == 1 ifTrue:[

        methodCategoryInOtherPackages := methodCategoriesInOtherPackages anElement.

    ].

    methodCategoriesWithUnassignedMethods size == 1 ifTrue:[

        methodCategoryWithUnassignedMethods := methodCategoriesWithUnassignedMethods anElement.

    ].

    isDefaultAnswer := false.

    (SourceCodeManagerUtilities yesToAllNotification notNil 

    and:[SourceCodeManagerUtilities yesToAllNotification isHandled]) ifTrue:[

        answer := isDefaultAnswer := true.

    ] ifFalse:[

        methodCategoriesWithUnassignedMethods size == 1 ifTrue:[

            unassignedMethods size == 1 ifTrue:[

                msg := 'The class ''%1'' contains the unassigned (loose) method: %6'.

                msg := msg , '\(In the ''%4'' category).'.

            ] ifFalse:[

                msg := 'The class ''%1'' contains %3 unassigned (loose) method(s)'.

                msg := msg , '\(In the ''%4'' category).'.

            ]

        ] ifFalse:[

            msg := 'The class ''%1'' contains %3 unassigned (loose) methods in %5 categories.'.

        ].

        unassignedMethods size == 1 ifTrue:[

            msg := msg , '\\Move this method to the ''%2'' package ?'.

            msg := msg , '\\Hint: if this is meant to be an extension of another package,\move it to the appropriate package and checkIn the extension(s).'.

        ] ifFalse:[

            msg := msg , '\\Move those to the ''%2'' package ?'.

            msg := msg , '\\Hint: if these are meant to be extensions of another package,\move them to the appropriate package and checkIn the extensions.'.

        ].

        args := Array

                    with:aClass name allBold