"
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'!
availableManagers
^ AbstractSourceCodeManager allSubclasses
reject:[:cls | (cls isAbstract) or:[cls isExperimental ]].
"
self availableManagers
"
!
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 directory: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
"Created: / 23-08-2006 / 14:07:08 / 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'!
checkForExistingContainer:fileName inModule:moduleName directory:dirName
"check for a container to be present"
^ self subclassResponsibility.
"Created: / 13-09-2006 / 18:22:24 / cg"
!
checkForExistingContainer:fileName inPackage:aPackage
"check if a source-code container is present in a packages directory."
|packageDir moduleDir|
packageDir := aPackage asPackageId directory.
moduleDir := aPackage asPackageId module.
^ self
checkForExistingContainer:fileName
inModule:moduleDir
directory:packageDir
"Created: / 13-09-2006 / 18:10:30 / cg"
!
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 directoryFromSourceInfo:sourceInfo.
moduleDir := self moduleFromSourceInfo:sourceInfo. "/ use the modules name as CVS module
classFileName := self containerFromSourceInfo:sourceInfo.
^ self
checkForExistingContainer:classFileName
inModule:moduleDir
directory:packageDir
"Created: / 13-05-1998 / 22:35:50 / cg"
"Modified: / 13-09-2006 / 18:23:20 / 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 directory:packageDir
"check for a package directory to be present"
^ self subclassResponsibility.
"Created: / 23-08-2006 / 14:03: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 directory:directory
"create a new package directory"
^ self subclassResponsibility.
"Created: / 23-08-2006 / 14:04:41 / cg"
!
initialRevisionStringFor:aClass inModule:moduleDir directory:packageDir container:fileName
"return a string usable as initial revision string"
^ self subclassResponsibility
"Created: / 23-08-2006 / 14:05:42 / 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)"
|extractBaseAndVersion versionIsGreater vsnNumberString baseName|
CacheDirectoryName isNil ifTrue:[^ self].
extractBaseAndVersion :=
[:filenameString |
|i|
i := filenameString size.
[i > 0 and:[(filenameString at:i) isDigit or:[(filenameString at:i) == $.]]] whileTrue:[ i := i - 1 ].
vsnNumberString := filenameString copyFrom:i + 1.
(filenameString at:i) == $_ ifTrue:[i := i - 1].
baseName := filenameString copyTo:i.
].
versionIsGreater :=
[:vA :vB |
|seqA seqB sequenceIsGreater|
seqA := (vA asCollectionOfSubstringsSeparatedBy:$.) collect:[:each | Integer readFrom:each].
seqB := (vB asCollectionOfSubstringsSeparatedBy:$.) collect:[:each | Integer readFrom:each].
sequenceIsGreater :=
[:seqA :seqB :index |
|elA elB|
elA := seqA at:index.
elB := seqB at:index.
elA > elB ifTrue:[
true
] ifFalse:[
elA < elB ifTrue:[
false
] ifFalse:[
sequenceIsGreater value:seqA value:seqB value:index+1.
].
].
].
sequenceIsGreater value:seqA value:seqB value:1.
].
CacheDirectoryName asFilename withAllDirectoriesDo:[:d |
|allFiles newestVersions|
newestVersions := Dictionary new.
allFiles := d files.
allFiles do:[:eachFilename |
|prevVsnString|
extractBaseAndVersion value:eachFilename baseName.
vsnNumberString notEmpty ifTrue:[
prevVsnString := newestVersions at:baseName ifAbsent:nil.
prevVsnString isNil ifTrue:[
newestVersions at:baseName put:vsnNumberString.
] ifFalse:[
(versionIsGreater value:vsnNumberString value:prevVsnString) ifTrue:[
newestVersions at:baseName put:vsnNumberString
]
].
].
].
allFiles do:[:eachFilename |
extractBaseAndVersion value:eachFilename baseName.
(vsnNumberString isEmpty
or:[(vsnNumberString ~= (newestVersions at:baseName))]) ifTrue:[
eachFilename remove
]
].
]
"
self condenseSourceCache
"
"Modified: / 29-08-2006 / 11:25:25 / cg"
!
flushSourceCache
"remove all cached versions"
|d|
CacheDirectoryName notNil ifTrue:[
d := CacheDirectoryName asFilename.
d isDirectory ifTrue:[
d directoryContentsAsFilenames do:[:eachFile |
eachFile recursiveRemove
]
].
]
"
self flushSourceCache
"
"Modified: / 29-08-2006 / 11:25:47 / cg"
! !
!AbstractSourceCodeManager class methodsFor:'obsolete backward compatibility'!
checkForExistingContainerInModule:moduleDir directory:packageDir container:fileName
"check for a container to exist"
self obsoleteMethodWarning.
^ self checkForExistingContainer:fileName inModule:moduleDir directory:packageDir
"Modified: / 13-09-2006 / 18:23:45 / cg"
!
checkForExistingContainerInModule:moduleName package:dirName container:fileName
"check for a container to be present"
<resource: #obsolete>
self obsoleteMethodWarning.
^ self
checkForExistingContainer:fileName
inModule:moduleName
directory:dirName
"Modified: / 13-09-2006 / 18:23:35 / cg"
!
checkForExistingModule:moduleDir package:packageDir
"check for a package directory to be present"
<resource: #obsolete>
self obsoleteMethodWarning.
^ self checkForExistingModule:moduleDir directory:packageDir.
"Created: / 09-12-1995 / 19:02:23 / cg"
"Modified: / 23-08-2006 / 14:03:25 / 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."
<resource: #obsolete>
self obsoleteMethodWarning.
^ self checkoutModule:aModule directory:aPackage andDo:aBlock
"Modified: / 23-08-2006 / 14:07:31 / cg"
!
createModule:module package:package
"create a new package directory"
<resource: #obsolete>
self obsoleteMethodWarning.
^ self createModule:module directory:package.
"Created: / 09-12-1995 / 19:02:23 / cg"
"Modified: / 23-08-2006 / 14:04:59 / cg"
!
getExistingContainersInModule:aModule package:aPackage
"{ Pragma: +optSpace }"
"return a collection containing the names of existing containers"
<resource: #obsolete>
self obsoleteMethodWarning.
^ self getExistingContainersInModule:aModule directory:aPackage
"Created: / 20-05-1998 / 19:49:12 / cg"
"Modified: / 23-08-2006 / 14:12:24 / cg"
!
getExistingPackagesInModule:aModule
"{ Pragma: +optSpace }"
"return a collection containing the names of existing packages"
<resource: #obsolete>
self obsoleteMethodWarning.
^ self getExistingDirectoriesInModule:aModule
"Created: / 20-05-1998 / 19:38:34 / cg"
"Modified: / 23-08-2006 / 14:14:04 / cg"
!
initialRevisionStringFor:aClass inModule:moduleDir package:packageDir container:fileName
"return a string usable as initial revision string"
<resource: #obsolete>
self obsoleteMethodWarning.
^ self initialRevisionStringFor:aClass inModule:moduleDir directory:packageDir container:fileName
"Created: / 14-02-1997 / 21:01:41 / cg"
"Modified: / 23-08-2006 / 14:06:18 / cg"
! !
!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
with:clsPackage allBold
with:unassignedMethods size
with:methodCategoryWithUnassignedMethods
with:methodCategoriesWithUnassignedMethods size
with:unassignedMethods first selector allBold.
SourceCodeManagerUtilities yesToAllNotification isHandled
ifTrue:[
labels := #('Cancel' 'No' 'Browse' 'Yes to all' 'Yes').
actions := #(#cancel false #browse #yesToAll true).
] ifFalse:[
labels := #('Cancel' 'No' 'Browse' 'Yes').
actions := #(#cancel false #browse true).
].
answer := OptionBox
request:(SystemBrowser classResources
stringWithCRs:msg
withArgs:args)
label:'Change packageID ?'
image:(InfoBox iconBitmap)
buttonLabels:(Dialog resources array:labels)
values:actions
default:true.
answer == #browse ifTrue:[
UserPreferences current systemBrowserClass
browseMethods:methodsFromOtherPackages
title:('Extensions in %1' bindWith:aClass name)
sort:true.
answer := #cancel.
].
].
answer == #cancel ifTrue:[
AbortSignal raise
].
answer == #yesToAll ifTrue:[
SourceCodeManagerUtilities yesToAllNotification raiseWith:true.
answer := true.
].
"/ ok, move them over
answer == true ifTrue:[
"/ change all method's packageID to the classes packageId
aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
mthd package == Project noProjectID ifTrue:[
mthd makeLocalStringSource.
mthd setPackage:clsPackage
]
].
aClass allPrivateClassesDo:[:eachPrivateClass |
aClass setPackage:clsPackage.
eachPrivateClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
mthd makeLocalStringSource.
mthd setPackage:clsPackage
]
].
aClass changed:#projectOrganization.
Smalltalk changed:#projectOrganization with:(Array with:aClass).
].
^ #base
"Modified: / 18-08-2006 / 12:27:51 / cg"
!
containerFromSourceInfo:info
"given a sourceInfo, return the classes container"
(info includesKey:#fileName) ifTrue:[
^ info at:#fileName
].
(info includesKey:#expectedFileName) ifTrue:[
^ info at:#expectedFileName
].
^ (info at:#classFileNameBase) , '.st'
"Modified: 12.9.1996 / 02:31:52 / cg"
!
directoryFromContainerPath:containerPath forClass:aClass
"given a full path as in an RCS header,
extract the directory (i.e. package)."
^ self directoryFromContainerPath:containerPath forPackage:(aClass package)
"
CVSSourceCodeManager directoryFromContainerPath:'/files/CVS/stx/libbasic/Array.st' forClass:Array
"
!
directoryFromContainerPath:containerPath forPackage:packageID
"given a full path as in an RCS header,
extract the directory (i.e. package)."
|path idx|
path := self pathInRepositoryFrom:containerPath forPackage:packageID.
path isNil ifTrue:[^ nil].
"/ these are always UNIX filenames ...
idx := path indexOf:$/.
idx ~~ 0 ifTrue:[
path := path copyFrom:(idx + 1)
].
"/ the code below used to be:
"/ ^ path asFilename directoryName
"/ however, that only works under UNIX, since
"/ we MUST return a unix pathname here.
"/ therefore, do what unix would do here ...
idx := path lastIndexOf:$/.
idx == 0 ifTrue:[
"/ huh ?
^ path
].
^ path copyTo:(idx - 1)
"
CVSSourceCodeManager directoryFromContainerPath:'/files/CVS/stx/libbasic/Array.st'
"
"Created: / 25.9.1998 / 15:37:06 / cg"
"Modified: / 25.9.1998 / 15:38:59 / cg"
!
directoryFromSourceInfo:info
"given a sourceInfo, return the classes package directory"
^ info at:#directory.
"Created: / 23-08-2006 / 14:10:29 / cg"
!
moduleFromContainerPath:containerPath forClass:aClass
"given a full path as in an RCS header, extract the module."
^ self moduleFromContainerPath:containerPath forPackage:aClass package
"
SourceCodeManager moduleFromContainerPath:'/files/CVS/stx/libbasic/Array.st' forClass:Array
"
!
moduleFromContainerPath:containerPath forPackage:packageID
"given a full path as in an RCS header, extract the module."
|path idx|
path := self pathInRepositoryFrom:containerPath forPackage:packageID.
path isNil ifTrue:[^ nil].
"/ these are always UNIX filenames
idx := path indexOf:$/.
idx == 0 ifTrue:[^ path].
^ path copyTo:(idx - 1)
"
SourceCodeManager moduleFromContainerPath:'/files/CVS/stx/libbasic/Array.st'
"
"Created: / 25.11.1995 / 18:42:20 / cg"
"Modified: / 11.8.1998 / 23:01:24 / cg"
!
moduleFromSourceInfo:info
"given a sourceInfo, return the classes module directory"
^ info at:#module. "/ use the modules name as CVS module
"Created: 6.2.1996 / 17:26:38 / cg"
"Modified: 12.9.1996 / 02:32:23 / cg"
!
packageFromSourceInfo:info
"given a sourceInfo, return the classes package directory"
<resource: #obsolete>
self obsoleteMethodWarning.
^ info at:#directory.
"Created: / 06-02-1996 / 17:26:23 / cg"
"Modified: / 23-08-2006 / 14:11:18 / cg"
!
pathInRepositoryFrom:containerPath forPackage:packageID
"this tries to extract the path within a repository, given some path
as present in an RCS Header string.
Typically, this ought to be that string directly;
however, if the repository directory is accessed via a symbolic link during
ci/co, some systems extract different strings with co.
One such system here had a symbolic link from /phys/ibm/CVS... to /file/CVS,
and extracted sources had /phys/ibm/CVS in their header.
Do not depend on the code below to work correctly all the time."
|top lastTop idx|
containerPath isNil ifTrue:[^ nil].
packageID notNil ifTrue:[
idx := containerPath lastIndexOfSubCollection:(packageID copyReplaceAll:$: with:$/).
idx ~~ 0 ifTrue:[
^ containerPath copyFrom:idx.
].
].
"/
"/ the following is heuristics, in case that the packageID is not known
"/ (should not be required)
"/
top := self repositoryTopDirectoryFromCVSRoot.
top notNil ifTrue:[
(containerPath startsWith:(top , '/')) ifTrue:[
^ containerPath copyFrom:(top size + 2).
].
(containerPath startsWith:(top)) ifTrue:[
^ containerPath copyFrom:(top size + 1).
].
"/ hardcase - the repository-filename in the versionInfo
"/ does not match my repository top.
"/ check for mangled prefix (happens with symbolic links)
lastTop := '/' , top asFilename baseName, '/'.
idx := containerPath indexOfSubCollection:lastTop.
idx ~~ 0 ifTrue:[
('SourceCodeManager [warning]: warning: repository path mismatch: ' , (containerPath copyTo:idx-1) , lastTop , ' vs. ' , top , '/') infoPrintCR.
'SourceCodeManager [info]: warning: assuming that mismatch is ok.' infoPrintCR.
^ containerPath copyFrom:(idx + lastTop size).
]
].
^ nil
"
SourceCodeManager pathInRepositoryFrom:'/files/CVS/stx/libbasic/Array.st' forPackage:Array package
SourceCodeManager pathInRepositoryFrom:'/phys/ibm/CVS/stx/libbasic/Array.st' forPackage:Array package
SourceCodeManager pathInRepositoryFrom:'/files/CVS/stx/libbasic/Array.st' forPackage:nil
SourceCodeManager pathInRepositoryFrom:'/phys/ibm/CVS/stx/libbasic/Array.st' forPackage:nil
"
"Created: / 25-11-1995 / 18:42:20 / cg"
"Modified: / 21-06-2006 / 12:06:14 / cg"
!
postCheckInClass:aClass
"invoked after a checkIn"
|p|
(p := Project current) notNil ifTrue:[
p condenseChangesForClassCheckin:aClass.
]
"Created: / 5.11.2001 / 14:23:00 / cg"
!
postCheckInExtensionsForPackage:aPackageId
"invoked after a checkIn"
|p|
(p := Project current) notNil ifTrue:[
p condenseChangesForExtensionsCheckInInPackage:aPackageId.
]
"Created: / 5.11.2001 / 14:23:31 / cg"
"Modified: / 5.11.2001 / 17:07:38 / cg"
!
reportError:msg
|fullMsg|
fullMsg := self class name,' [error]: ',msg.
fullMsg errorPrintCR.
SourceCodeManagerError raiseErrorString:fullMsg.
"Created: / 29-08-2006 / 12:44:19 / cg"
!
repositoryTopDirectory
"return the name of the repository"
^ nil
"Created: 25.11.1995 / 18:38:59 / cg"
"Modified: 12.9.1996 / 02:32:40 / cg"
!
revisionAfter:aRevisionString
"generate the next revision number after the given number"
|idx|
idx := aRevisionString lastIndexOf:$..
idx == 0 ifTrue:[
^ ((Integer readFrom:aRevisionString) + 1) printString
].
^ (aRevisionString copyTo:idx) , ((Integer readFrom:(aRevisionString copyFrom:(idx+1)))+1) printString
"
SourceCodeManager revisionAfter:'1.2.3.4'
SourceCodeManager revisionAfter:'123'
SourceCodeManager revisionAfter:'1.24'
"
"Created: 20.11.1995 / 12:54:05 / cg"
"Modified: 12.9.1996 / 02:33:03 / cg"
!
sourceCacheDirectory
"return the sourceCache directories name"
|dir nm|
(nm := self cacheDirectoryName) isNil ifTrue:[^ nil].
(dir := nm asFilename) exists ifFalse:[
OperatingSystem errorSignal catch:[
dir makeDirectory.
].
dir exists ifFalse:[
'SourceCodeManager [warning]: could not create cache dir ''' , CacheDirectoryName , '''' infoPrintCR.
^ nil
].
"/
"/ make it read/writable for everyone
"/
dir makeReadableForAll.
dir makeWritableForAll.
dir makeExecutableForAll.
].
^ dir
"Modified: 10.1.1997 / 15:13:20 / cg"
!
sourceInfoOfClass:aClass
"helper: return a classes sourceCodeInfo by extracting its
versionString components."
|cls packageInfo revInfo actualSourceFileName classFileNameBase
newInfo container expectedFileName
directoryFromVersion moduleFromVersion fileNameFromVersion
directoryFromPackage moduleFromPackage|
cls := aClass theNonMetaclass.
newInfo := IdentityDictionary new.
"/
"/ the info given by the classes source ...
"/ (i.e. its revisionString)
"/
revInfo := cls revisionInfo.
revInfo notNil ifTrue:[
revInfo keysAndValuesDo:[:key :value |
newInfo at:key put:value
]
].
"/
"/ the info given by the classes binary ...
"/ (i.e. its package-ID)
"/ if present, we better trust that one.
"/ however, it only contains partial information (module:directory:libName).
"/ (but is available even without a source)
"/
packageInfo := cls packageSourceCodeInfo.
packageInfo notNil ifTrue:[
packageInfo keysAndValuesDo:[:key :value |
newInfo at:key put:value
]
].
"/
"/ no information
"/
(packageInfo isNil and:[revInfo isNil]) ifTrue:[
('SourceCodeManager [warning]: class `' , cls name , ''' has neither source nor compiled-in info') infoPrintCR.
^ nil
].
"/
"/ validate for conflicts
"/ trust binary if in doubt
"/ (in case some cheater edited the version string)
"/
revInfo notNil ifTrue:[
(revInfo includesKey:#repositoryPathName) ifTrue:[
container := revInfo at:#repositoryPathName ifAbsent:nil.
moduleFromVersion := self moduleFromContainerPath:container forClass:aClass.
moduleFromVersion notNil ifTrue:[
newInfo at:#module put:moduleFromVersion.
].
directoryFromVersion := self directoryFromContainerPath:container forClass:aClass.
directoryFromVersion notNil ifTrue:[
newInfo at:#directory put:directoryFromVersion.
].
fileNameFromVersion := container asFilename baseName.
(fileNameFromVersion endsWith:',v') ifTrue:[
fileNameFromVersion := fileNameFromVersion copyWithoutLast:2.
].
newInfo at:#fileName put:fileNameFromVersion.
packageInfo notNil ifTrue:[
(packageInfo includesKey:#directory) ifTrue:[
directoryFromPackage := packageInfo at:#directory.
moduleFromPackage := packageInfo at:#module.
(directoryFromPackage ~= directoryFromVersion
or:[moduleFromPackage ~= moduleFromVersion]) ifTrue:[
(directoryFromVersion isNil or:[moduleFromVersion isNil]) ifTrue:[
directoryFromPackage ~= 'no package' ifTrue:[
moduleFromVersion notNil ifTrue:[
('SourceCodeManager [warning]: conflicting source infos (binary: '
, (moduleFromPackage ? 'nil') , '/' , (directoryFromPackage ? 'nil')
, ' vs. source:'
, (moduleFromVersion ? 'nil') , '/' , (directoryFromVersion ? 'nil')
, ')') infoPrintCR.
('SourceCodeManager [info]: using binary info: '
, moduleFromPackage , '/' , directoryFromPackage
) infoPrintCR.
].
newInfo at:#directory put:directoryFromPackage.
newInfo at:#module put:moduleFromPackage.
]
] ifFalse:[
directoryFromPackage ~= 'no package' ifTrue:[
('SourceCodeManager [warning]: conflicting source infos (binary: '
, moduleFromPackage , '/' , directoryFromPackage
, ' vs. source:'
, moduleFromVersion , '/' , directoryFromVersion
, ')') infoPrintCR.
]
]
]
]
].
]
].
"/
"/ the filename I'd expect from its name ...
"/
classFileNameBase := cls classBaseFilename.
(newInfo includesKey:#fileName) ifFalse:[
newInfo at:#fileName put:classFileNameBase
].
"/ guess on the container
((newInfo includesKey:#directory) and:[newInfo includesKey:#module]) ifTrue:[
|pathInRepository|
container isNil ifTrue:[
container := (newInfo at:#module)
, '/'
, (newInfo at:#directory)
, '/'
, classFileNameBase , ',v'.
].
pathInRepository := (newInfo at:#module)
, '/'
, (newInfo at:#directory)
, '/'
, classFileNameBase.
newInfo at:#pathInRepository put:pathInRepository.
].
container notNil ifTrue:[
newInfo at:#repositoryPathName put:container.
].
"/ check ..
revInfo notNil ifTrue:[
actualSourceFileName := revInfo at:#fileName ifAbsent:nil.
actualSourceFileName notNil ifTrue:[
expectedFileName := classFileNameBase.
actualSourceFileName ~= expectedFileName ifTrue:[
('SourceCodeManager [warning]: source of class ' , cls name , ' in ' , actualSourceFileName , ';') infoPrintCR.
('SourceCodeManager [info]: (expected: ' , expectedFileName , '); renamed or missing abbreviation ?') infoPrintCR.
('SourceCodeManager [info]: This may fail to autoload later if left unchanged.') infoPrintCR.
newInfo at:#expectedFileName put:expectedFileName.
newInfo at:#renamed put:true.
classFileNameBase := actualSourceFileName
]
]
].
newInfo at:#classFileNameBase put:(classFileNameBase asFilename nameWithoutSuffix).
^ newInfo
"
self sourceInfoOfClass:Array
"
"Modified: / 07-11-2006 / 13:58:21 / cg"
! !
!AbstractSourceCodeManager class methodsFor:'source code access'!
checkinClass:aClass fileName:classFileName directory:packageDir module:moduleDir logMessage:logMessage
"checkin of a class into the source repository.
Return true if ok, false if not."
^ self
checkinClass:aClass
fileName:classFileName
directory:packageDir
module:moduleDir
logMessage:logMessage
force:false
"Modified: 11.9.1996 / 16:15:43 / cg"
!
checkinClass:aClass fileName:classFileName directory:packageDir module:moduleDir logMessage:logMessage force:force
"checkin of a class into the source repository.
Return true if ok, false if not."
|tempDir tempFile ok packageMode filter className answer allLabel allValue|
className := aClass name.
aClass revision isNil ifTrue:[
force ifFalse:[
('CVSSourceCodeManager [warning]: class ' , className, ' has no revision string') errorPrintCR.
AbortAllSignal isHandled ifTrue:[
allLabel := #('Cancel All').
allValue := #(cancelAll).
] ifFalse:[
allLabel := #().
allValue := #().
].
(aClass theMetaclass includesSelector:#version) ifTrue:[
answer := OptionBox
request:('Class %1 has no (usable) revision string.\\Check in as newest ?' bindWith:className allBold) withCRs
label:'Confirm'
buttonLabels:(allLabel , #('Cancel' 'CheckIn'))
values:(allValue , #(false #checkIn))
default:#checkIn.
] ifFalse:[
answer := OptionBox
request:('Class %1 has no revision string.\\Check in as newest ?' bindWith:className allBold) withCRs
label:'Confirm'
buttonLabels:(allLabel , #('Cancel' 'CheckIn' 'Create & CheckIn'))
values:(allValue , #(false #checkIn #create))
default:#create.
].
answer == false ifTrue:[ AbortSignal raise. ^ false ].
answer == #cancelAll ifTrue:[ AbortAllSignal raise. ^ false ].
answer == #create ifTrue:[
aClass theNonMetaclass updateVersionMethodFor:'$' , 'Header' , '$'. "/ concatenated to avoid RCS expansion
].
]
].
packageMode := self checkMethodPackagesOf:aClass.
packageMode == #base ifTrue:[
filter := [:mthd | mthd package = aClass package].
].
tempDir := Filename newTemporaryDirectory.
ok := false.
[
|aStream|
tempFile := tempDir construct:classFileName.
[
aStream := tempFile writeStream.
] on:FileStream openErrorSignal do:[:ex|
self reportError:('temporary fileout failed').
^ false
].
Method flushSourceStreamCache.
Class fileOutErrorSignal handle:[:ex |
aStream close.
self reportError:('fileout failed (',ex description,')').
^ false
] do:[
aClass
fileOutOn:aStream
withTimeStamp:false
withInitialize:true
withDefinition:true
methodFilter:filter
].
aStream close.
tempFile exists ifFalse:[
self reportError:'temporary fileout failed'.
^ false.
].
ok := self
checkinClass:aClass
fileName:classFileName
directory:packageDir
module:moduleDir
source:(tempFile name)
logMessage:logMessage
force:force.
] ensure:[
tempDir recursiveRemove
].
^ ok
"
SourceCodeManager checkinClass:Array
"
"Created: / 11-09-1996 / 16:15:17 / cg"
"Modified: / 25-09-1997 / 12:16:00 / stefan"
"Modified: / 29-08-2006 / 12:47:32 / cg"
!
checkinClass:aClass logMessage:logMessage
"checkin of a class into the source repository.
Return true if ok, false if not."
|sourceInfo packageDir moduleDir classFileName|
sourceInfo := self sourceInfoOfClass:aClass.
sourceInfo isNil ifTrue:[
self reportError:('no sourceInfo for class: ' , aClass name).
^ false
].
packageDir := self directoryFromSourceInfo:sourceInfo.
moduleDir := self moduleFromSourceInfo:sourceInfo. "/ use the modules name as CVS module
classFileName := self containerFromSourceInfo:sourceInfo.
^ self
checkinClass:aClass
fileName:classFileName
directory:packageDir
module:moduleDir
logMessage:logMessage
"
SourceCodeManager checkinClass:Array logMessage:'foo'
"
"Created: / 06-11-1995 / 18:56:00 / cg"
"Modified: / 29-08-2006 / 12:46:28 / cg"
!
getFile:fileName revision:revision directory:packageDir module:moduleDir
|s contents|
s := self
streamForFile:fileName
revision:revision
directory:packageDir
module:moduleDir.
s isNil ifTrue:[^ nil].
contents := s contentsOfEntireFile.
s close.
^ contents
"
SourceCodeManager
getFile:'Make.spec'
revision:#newest
directory:'libbasic2'
module:'stx'
"
"Created: / 29-08-2006 / 15:47:08 / cg"
!
getMostRecentSourceStreamForClassNamed:aClassName
"given a class, return an open stream to its most recent source
(not knowing anything about its version).
Used when autoloading classes."
^ self
getMostRecentSourceStreamForClassNamed:aClassName
inPackage:nil
!
getMostRecentSourceStreamForClassNamed:aClassName inPackage:forcedPackage
"given a class, return an open stream to its most recent source
(not knowing anything about its version).
Used when autoloading classes or to compare a classes source with the most
recent found in the repostitory.
The forcePackage argument passes the classes package information
and is only required when autoloading or when the class is not already
present (i.e. there is no way to extract the package info).
If nil, the package is extracted from the class - which must exist."
|cls sourceInfo classFileName packageDir moduleDir s components i|
cls := Smalltalk classNamed:aClassName.
cls notNil ifTrue:[
sourceInfo := self sourceInfoOfClass:cls.
].
sourceInfo notNil ifTrue:[
packageDir := self directoryFromSourceInfo:sourceInfo.
moduleDir := self moduleFromSourceInfo:sourceInfo. "/ use the modules name as CVS module
classFileName := self containerFromSourceInfo:sourceInfo.
] ifFalse:[
classFileName := (Smalltalk fileNameForClass:aClassName), '.st'.
packageDir := Smalltalk sourceDirectoryNameOfClass:aClassName.
packageDir notNil ifTrue:[
(packageDir startsWith:'stx/') ifTrue:[
"this is a backward compatibility leftover - will vanish"
packageDir := packageDir copyFrom:5.
] ifFalse:[
i := packageDir indexOf:$:.
i ~~ 0 ifTrue:[
moduleDir := packageDir copyTo:i-1.
packageDir := packageDir copyFrom:i+1
]
]
].
moduleDir isNil ifTrue:[
moduleDir := 'stx'
].
].
packageDir isNil ifTrue:[
forcedPackage isNil ifTrue:[
'SourceCodeManager [warning]: could not extract packageDir' errorPrintCR.
^ nil
].
moduleDir := forcedPackage asPackageId module.
packageDir := forcedPackage asPackageId directory.
].
s := self
streamForClass:nil
fileName:classFileName
revision:#newest
directory:packageDir
module:moduleDir
cache:false.
s isNil ifTrue:[
"/ guessed moduleDir ?
sourceInfo isNil ifTrue:[
components := Filename components:packageDir.
moduleDir := components first.
packageDir := (Filename fromComponents:(components copyFrom:2)) asString.
s := self
streamForClass:nil
fileName:classFileName
revision:#newest
directory:packageDir
module:moduleDir
cache:false.
]
].
^ s.
"Created: / 12-10-1996 / 17:22:54 / cg"
"Modified: / 06-10-2006 / 16:17:33 / cg"
!
getMostRecentSourceStreamForFile:aFileName inPackage:aPackage
"given a filename, return an open stream to its most recent contents
(not knowing anything about its version).
Used when autoloading extensions or to compare a classes source with the most
recent found in the repostitory."
|directory module|
module := aPackage asPackageId module.
directory := aPackage asPackageId directory.
^ self
streamForFile:aFileName
revision:#newest
directory:directory
module:module.
"Created: / 12-10-1996 / 17:22:54 / cg"
"Modified: / 29-08-2006 / 15:49:02 / cg"
!
getSourceStreamFor:aClass
"extract a classes source code and return an open readStream on it.
The classes source code is extracted using the revision and the sourceCodeInfo,
which itself is extracted from the classes packageString."
^ self getSourceStreamFor:aClass revision:nil
"Created: 12.10.1996 / 17:21:03 / cg"
"Modified: 12.10.1996 / 17:22:02 / cg"
!
getSourceStreamFor:aClass revision:aRevisionStringOrNil
"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."
|classFileName revision
packageDir moduleDir sourceInfo|
aRevisionStringOrNil == #newest ifTrue:[
^ self getMostRecentSourceStreamForClassNamed:(aClass theNonMetaclass name).
].
aRevisionStringOrNil isNil ifTrue:[
revision := aClass binaryRevision.
revision isNil ifTrue:[
revision := aClass revision.
revision isNil ifTrue:[
('SourceCodeManager [warning]: class `' , aClass name , ''' has no revision string') infoPrintCR.
^ nil.
].
('SourceCodeManager [info]: trusting classes revision ...') infoPrintCR.
]
] ifFalse:[
revision := aRevisionStringOrNil
].
sourceInfo := self sourceInfoOfClass:aClass.
sourceInfo isNil ifTrue:[
('SourceCodeManager [warning]: no sourceInfo for class `' , aClass name , '''') infoPrintCR.
^ nil
].
packageDir := self directoryFromSourceInfo:sourceInfo.
moduleDir := self moduleFromSourceInfo:sourceInfo. "/ use the modules name as CVS module
classFileName := self containerFromSourceInfo:sourceInfo.
^ self
streamForClass:aClass
fileName:classFileName
revision:revision
directory:packageDir
module:moduleDir
cache:true
"Created: / 12-10-1996 / 17:21:52 / cg"
"Modified: / 23-08-2006 / 14:10:45 / cg"
!
streamForFile:fileName revision:revision directory:packageDir module:moduleDir
^ self
streamForClass:nil
fileName:fileName
revision:revision
directory:packageDir
module:moduleDir
cache:true
"
SourceCodeManager
streamForFile:'Make.spec'
revision:#newest
directory:'libbasic2'
module:'stx'
"
"Created: / 29-08-2006 / 15:41:43 / cg"
! !
!AbstractSourceCodeManager class methodsFor:'source code administration'!
getExistingContainersInModule:aModule directory:aPackage
"{ Pragma: +optSpace }"
"return a collection containing the names of existing containers"
^ self subclassResponsibility
"Created: / 23-08-2006 / 14:12:07 / cg"
!
getExistingDirectoriesInModule:aModule
"{ Pragma: +optSpace }"
"return a collection containing the names of existing packages"
^ self subclassResponsibility
"Created: / 23-08-2006 / 14:13:52 / cg"
!
getExistingModules
"{ Pragma: +optSpace }"
"return a collection containing the names of existing modules"
^ self subclassResponsibility
"Modified: / 29.1.1997 / 18:57:29 / cg"
"Created: / 20.5.1998 / 19:38:23 / cg"
!
initialRCSRevisionStringFor:aClass in:dir container:fileName
"return a string usable as initial revision string"
"/ do not make the string below into one string;
"/ RCS would expand it into a wrong rev-string
|nm oldRev idx special|
nm := fileName.
(nm endsWith:',v') ifTrue:[
nm := nm copyWithoutLast:2
].
(nm endsWith:'.st') ifFalse:[
nm := nm , '.st'
].
oldRev := aClass revisionString.
special := ''.
oldRev notNil ifTrue:[
idx := oldRev lastIndexOf:$[.
idx ~~ 0 ifTrue:[
idx := oldRev indexOf:$[ startingAt:idx+1.
idx ~~ 0 ifTrue:[
special := ' ' , (oldRev copyFrom:idx).
]
]
].
^ '$' , 'Header: ' , dir , '/' , fileName , ',v $'
, special
"Modified: 17.9.1996 / 15:57:15 / cg"
"Created: 14.2.1997 / 20:59:28 / cg"
!
newestRevisionInFile:classFileName directory:packageDir module:moduleDir
"return the newest revision found in a container.
Return nil on failure."
|log|
log := self
revisionLogOf:nil
fromRevision:0
toRevision:0
fileName:classFileName
directory:packageDir
module:moduleDir.
log isNil ifTrue:[^ nil].
^ log at:#newestRevision ifAbsent:nil
"
SourceCodeManager newestRevisionInFile:'Array.st' directory:'libbasic' module:'stx'
"
"Modified: 10.1.1997 / 13:31:42 / cg"
!
newestRevisionLogEntryOf:aClass
"return the newest revisions log found in the repository.
Return nil on failure."
^ self revisionLogOf:aClass fromRevision:0 toRevision:0.
"
SourceCodeManager newestRevisionLogEntryOf:Array
SourceCodeManager newestRevisionLogEntryOf:Connection
"
"Modified: 10.1.1997 / 13:30:36 / cg"
"Created: 29.1.1997 / 18:50:12 / cg"
!
newestRevisionOf:aClass
"return the newest revision (as string) found in the repository.
Return nil on failure."
|sourceInfo packageDir moduleDir classFileName|
sourceInfo := self sourceInfoOfClass:aClass.
sourceInfo isNil ifTrue:[^ nil].
packageDir := self directoryFromSourceInfo:sourceInfo.
moduleDir := self moduleFromSourceInfo:sourceInfo. "/ use the modules name as CVS module
classFileName := self containerFromSourceInfo:sourceInfo.
^ self newestRevisionInFile:classFileName directory:packageDir module:moduleDir
"/ |log|
"/
"/ log := self revisionLogOf:aClass fromRevision:0 toRevision:0.
"/ log isNil ifTrue:[^ nil].
"/ ^ log at:#newestRevision ifAbsent:nil
"
SourceCodeManager newestRevisionOf:Array
SourceCodeManager newestRevisionOf:Connection
"
"Modified: / 23-08-2006 / 14:10:47 / cg"
!
revisionInfoFromRCSString:aString
"{ Pragma: +optSpace }"
"return a dictionary filled with revision info.
This extracts the relevant info from aString."
|words firstWord nextWord info nm|
info := IdentityDictionary new.
words := aString asCollectionOfWords readStream.
words atEnd ifFalse:[
firstWord := words next.
"/
"/ supported formats:
"/
"/ $-Header: pathName rev date time user state $
"/ $-Revision: rev $
"/ $-Id: fileName rev date time user state $
"/
(firstWord = '$Header:') ifTrue:[
nm := words next.
info at:#repositoryPathName put:nm.
(nm endsWith:',v') ifTrue:[
nm := nm copyWithoutLast:2
].
info at:#fileName put:nm asFilename baseName.
words atEnd ifFalse:[
nextWord := words next.
nextWord ~= '$' ifTrue:[
info at:#revision put:nextWord.
nextWord := words next.
nextWord ~= '$' ifTrue:[
info at:#date put:nextWord.
info at:#time put:words next.
nextWord := words next.
(nextWord startsWithAnyOf:'+-') ifTrue:[
info at:#timezone put:nextWord.
nextWord := words next.
].
info at:#user put:nextWord.
info at:#state put:words next.
]
].
].
^ info
].
(firstWord = '$Revision:') ifTrue:[
info at:#revision put:words next.
^ info
].
(firstWord = '$Id:') ifTrue:[
info at:#fileName put:(words next).
info at:#revision put:(words next).
info at:#date put:(words next).
info at:#time put:(words next).
info at:#user put:(words next).
info at:#state put:(words next).
^ info
].
].
^ nil
"
SourceCodeManager revisionInfoFromString:'$' , 'Revision: 1.122 $'
SourceCodeManager revisionInfoFromString:(SourceCodeManager version)
"
"Modified: 29.1.1997 / 18:56:31 / cg"
!
revisionInfoFromString:aString
"{ Pragma: +optSpace }"
"return a dictionary filled with revision info.
This extracts the relevant info from aString."
^ self subclassResponsibility
"Created: 29.1.1997 / 18:54:52 / cg"
"Modified: 29.1.1997 / 18:57:29 / cg"
!
revisionLogOf:aClass
"return info about the repository container and
the revisionlog as a collection of revision entries.
Return nil on failure.
The returned information is a structure (IdentityDictionary)
filled with:
#container -> the RCS container file name
#filename -> the actual source file name
#newestRevision -> the revisionString of the newest revision
#numberOfRevisions -> the number of revisions in the container
#revisions -> collection of per-revision info
per revision info consists of one record per revision:
#revision -> the revision string
#author -> who checked that revision into the repository
#date -> when was it checked in
#state -> the RCS state
#numberOfChangedLines -> the number of changed line w.r.t the previous
revisions are ordered newest first
(i.e. the last entry is for the initial revision; the first for the most recent one)
"
^ self
revisionLogOf:aClass fromRevision:nil toRevision:nil
"
SourceCodeManager revisionLogOf:Array
"
"Created: 25.11.1995 / 11:25:02 / cg"
"Modified: 25.11.1995 / 11:56:16 / cg"
!
revisionLogOf:aClass fromRevision:rev1
"return info about the repository container and
(part of) the revisionlog as a collection of revision entries.
Return nil on failure.
The returned information is a structure (IdentityDictionary)
filled with:
#container -> the RCS container file name
#filename -> the actual source file name
#newestRevision -> the revisionString of the newest revision
#numberOfRevisions -> the number of revisions in the container
#revisions -> collection of per-revision info (see below)
for some classes, additional info is returned:
#renamed -> true if the class has been renamed or copied
and the sourceInfo is from the previous one
#expectedFileName -> the filename we would expect (i.e. for the new class)
rev1 specifies from which revisions a logEntry is wanted:
If rev1 is nil, the first revision is the initial revision
otherwise, the log starts with that revision.
per revision info consists of one record per revision:
#revision -> the revision string
#author -> who checked that revision into the repository
#date -> when was it checked in
#state -> the RCS state
#numberOfChangedLines -> the number of changed line w.r.t the previous
revisions are ordered newest first
(i.e. the last entry is for the initial revision;
the first for the most recent one)
"
^ self revisionLogOf:aClass fromRevision:rev1 toRevision:nil
"
SourceCodeManager revisionLogOf:Array fromRevision:'1.40'
"
"Created: 6.11.1995 / 18:56:00 / cg"
"Modified: 10.1.1997 / 13:29:50 / cg"
!
revisionLogOf:aClass fromRevision:rev1 toRevision:rev2
"return info about the repository container and
(part of) the revisionlog as a collection of revision entries.
Return nil on failure.
The returned information is a structure (IdentityDictionary)
filled with:
#container -> the RCS container file name
#filename -> the actual source file name
#newestRevision -> the revisionString of the newest revision
#numberOfRevisions -> the number of revisions in the container
#revisions -> collection of per-revision info (see below)
for some classes, additional info is returned:
#renamed -> true if the class has been renamed or copied
and the sourceInfo is from the previous one
#expectedFileName -> the filename we would expect (i.e. for the new class)
rev1 / rev2 specify from which revisions a logEntry is wanted:
If rev1 is nil, the first revision is the initial revision
otherwise, the log starts with that revision.
If rev2 is nil, the last revision is the newest revision
otherwise, the log ends with that revision.
If both are nil, no logEntries are extracted (i.e. only the header).
per revision info consists of one record per revision:
#revision -> the revision string
#author -> who checked that revision into the repository
#date -> when was it checked in
#state -> the RCS state
#numberOfChangedLines -> the number of changed line w.r.t the previous
revisions are ordered newest first
(i.e. the last entry is for the initial revision;
the first for the most recent one)
"
|sourceInfo packageDir moduleDir classFileName info|
sourceInfo := self sourceInfoOfClass:aClass.
sourceInfo isNil ifTrue:[^ nil].
packageDir := self directoryFromSourceInfo:sourceInfo.
moduleDir := self moduleFromSourceInfo:sourceInfo. "/ use the modules name as CVS module
classFileName := self containerFromSourceInfo:sourceInfo.
info := self
revisionLogOf:aClass
fromRevision:rev1
toRevision:rev2
fileName:classFileName
directory:packageDir
module:moduleDir.
info notNil ifTrue:[
"/ (sourceInfo includesKey:#renamed) ifTrue:[
"/ info at:#renamed put:(sourceInfo at:#renamed)
"/ ].
(sourceInfo includesKey:#expectedFileName) ifTrue:[
info at:#expectedFileName put:(sourceInfo at:#expectedFileName)
]
].
^ info
"
SourceCodeManager revisionLogOf:Array fromRevision:'1.40' toRevision:'1.43'
SourceCodeManager revisionLogOf:XtBoxNew
"
"Created: / 06-11-1995 / 18:56:00 / cg"
"Modified: / 23-08-2006 / 14:10:50 / cg"
!
revisionLogOf:aClass numberOfRevisions:numRevisions
"return info about the repository container and
(part of) the revisionlog (numRevisions newest revisions)
as a collection of revision entries.
Return nil on failure.
The returned information is a structure (IdentityDictionary)
filled with:
#container -> the RCS container file name
#filename -> the actual source file name
#newestRevision -> the revisionString of the newest revision
#numberOfRevisions -> the number of revisions in the container (nil for all)
#revisions -> collection of per-revision info (see below)
for some classes, additional info is returned:
#renamed -> true if the class has been renamed or copied
and the sourceInfo is from the previous one
#expectedFileName -> the filename we would expect (i.e. for the new class)
rev1 / rev2 specify from which revisions a logEntry is wanted:
If rev1 is nil, the first revision is the initial revision
otherwise, the log starts with that revision.
If rev2 is nil, the last revision is the newest revision
otherwise, the log ends with that revision.
If both are nil, no logEntries are extracted (i.e. only the header).
per revision info consists of one record per revision:
#revision -> the revision string
#author -> who checked that revision into the repository
#date -> when was it checked in
#state -> the RCS state
#numberOfChangedLines -> the number of changed line w.r.t the previous
#logMessage -> the checkIn log message
revisions are ordered newest first
(i.e. the last entry is for the initial revision;
the first for the most recent one)
"
|sourceInfo packageDir moduleDir classFileName info|
sourceInfo := self sourceInfoOfClass:aClass.
sourceInfo isNil ifTrue:[^ nil].
packageDir := self directoryFromSourceInfo:sourceInfo.
moduleDir := self moduleFromSourceInfo:sourceInfo. "/ use the modules name as CVS module
classFileName := self containerFromSourceInfo:sourceInfo.
info := self
revisionLogOf:aClass
numberOfRevisions:numRevisions
fileName:classFileName
directory:packageDir
module:moduleDir.
info notNil ifTrue:[
"/ (sourceInfo includesKey:#renamed) ifTrue:[
"/ info at:#renamed put:(sourceInfo at:#renamed)
"/ ].
(sourceInfo includesKey:#expectedFileName) ifTrue:[
info at:#expectedFileName put:(sourceInfo at:#expectedFileName)
]
].
^ info
"
SourceCodeManager revisionLogOf:Array numberOfRevisions:10
"
"Modified: / 23-08-2006 / 14:10:52 / cg"
!
revisionLogOfContainer:classFileName directory:packageDir module:moduleDir
"return info about the repository container and
(part of) the revisionlog as a collection of revision entries.
Return nil on failure.
The returned information is a structure (IdentityDictionary)
filled with:
#container -> the RCS container file name
#filename -> the actual source file name
#newestRevision -> the revisionString of the newest revision
#numberOfRevisions -> the number of revisions in the container
#revisions -> collection of per-revision info (see below)
per revision info consists of one record per revision:
#revision -> the revision string
#author -> who checked that revision into the repository
#date -> when was it checked in
#state -> the RCS state
#numberOfChangedLines -> the number of changed line w.r.t the previous
revisions are ordered newest first
(i.e. the last entry is for the initial revision;
the first for the most recent one)
"
^ self
revisionLogOf:nil
fromRevision:nil
toRevision:nil
fileName:classFileName
directory:packageDir
module:moduleDir
"
CVSSourceCodeManager
revisionLogInFile:'Array.st' directory:'libbasic' module:'stx'
"
"Modified: 10.1.1997 / 13:29:06 / cg"
!
revisionLogOfContainer:fileName module:moduleDir directory:packageDir fromRevision:rev1 toRevision:rev2
"return info about the repository container and
(part of) the revisionlog as a collection of revision entries.
Return nil on failure.
The returned information is a structure (IdentityDictionary)
filled with:
#container -> the RCS container file name
#filename -> the actual source file name
#newestRevision -> the revisionString of the newest revision
#numberOfRevisions -> the number of revisions in the container
#revisions -> collection of per-revision info (see below)
for some classes, additional info is returned:
#renamed -> true if the class has been renamed or copied
and the sourceInfo is from the previous one
#expectedFileName -> the filename we would expect (i.e. for the new class)
rev1 / rev2 specify from which revisions a logEntry is wanted:
If rev1 is nil, the first revision is the initial revision
otherwise, the log starts with that revision.
If rev2 is nil, the last revision is the newest revision
otherwise, the log ends with that revision.
If both are nil, no logEntries are extracted (i.e. only the header).
per revision info consists of one record per revision:
#revision -> the revision string
#author -> who checked that revision into the repository
#date -> when was it checked in
#state -> the RCS state
#numberOfChangedLines -> the number of changed line w.r.t the previous
revisions are ordered newest first
(i.e. the last entry is for the initial revision;
the first for the most recent one)
"
|info|
info := self
revisionLogOf:nil
fromRevision:rev1
toRevision:rev2
fileName:fileName
directory:packageDir
module:moduleDir.
^ info
"
CVSSourceCodeManager revisionLogOfContainer:'Array.st' module:'stx' package:'libbasic' fromRevision:'1.40' toRevision:'1.43'
"
"Created: / 23-08-2006 / 14:14:59 / cg"
!
revisionsOf:aClass
"return a collection of revisions (as strings) found in the repository.
The most recent (newest) revision will be the first in the list.
Return nil on failure."
|log revisions|
log := self revisionLogOf:aClass.
log isNil ifTrue:[^ nil].
revisions := log at:#revisions ifAbsent:nil.
revisions isNil ifTrue:[^ nil].
^ revisions collect:[:rev | rev at:#revision].
"
SourceCodeManager revisionsOf:Array
SourceCodeManager newestRevisionOf:Array
"
"Modified: 10.4.1996 / 23:14:24 / cg"
"Created: 19.4.1996 / 17:24:34 / cg"
!
writeHistoryLogSince:timeGoal filterSTSources:filter filterUser:userFilter filterRepository:repositoryFilter filterModules:moduleFilter filterProjects:projectFilterArg to:aStream
"send a full historyLog to some stream.
This walks over all possible repository roots."
|projectFilter goalString prevUser prevCvsRoot |
projectFilter := projectFilterArg isEmptyOrNil ifTrue:nil ifFalse:projectFilterArg.
goalString := ''.
projectFilter notNil ifTrue:[
projectFilter size == 1 ifTrue:[
goalString := goalString , 'of ',projectFilter first.
] ifFalse:[
projectFilter size == 2 ifTrue:[
goalString := goalString , 'of ',projectFilter first,' and ',projectFilter second.
] ifFalse:[
goalString := goalString , 'of ',projectFilter size printString,' projects'.
].
].
goalString := goalString,' '
].
(timeGoal notEmptyOrNil) ifTrue:[
goalString := goalString , 'since ' , timeGoal,' '.
].
userFilter notNil ifTrue:[
userFilter isString ifTrue:[
goalString := 'by user ',userFilter
] ifFalse:[
userFilter size == 1 ifTrue:[
goalString := 'by user ',(userFilter first)
] ifFalse:[
goalString := 'by users ',(userFilter first),'...',(userFilter last)
]
].
goalString := goalString,' '.
].
aStream nextPutLine:'**** repository history ' , goalString , '****'.
aStream cr.
self
reportHistoryLogSince:timeGoal
filterSTSources:filter
filterUser:userFilter
filterRepository:repositoryFilter
filterModules:moduleFilter
inTo:[:info |
|user recordType fileName date time rev pkgDir
module directory pkg
clsName cvsRoot cls clsRev revInfo|
pkgDir := info at:#directory ifAbsent:'?'.
module := pkgDir upTo:$/.
directory := pkgDir copyFrom:(module size+2).
pkg := module,':',directory.
(projectFilter isEmptyOrNil
or:[ projectFilter includes:pkg ]) ifTrue:[
user := info at:#user ifAbsent:'?'.
recordType := info at:#cvsRecordType ifAbsent:'?'.
fileName := info at:#fileName ifAbsent:'?'.
date := info at:#date ifAbsent:'?'.
time := info at:#time ifAbsent:'?'.
rev := info at:#revision ifAbsent:'?'.
clsName := info at:#className ifAbsent:'?'.
cvsRoot := info at:#cvsRoot ifAbsent:'?'.
cvsRoot ~= prevCvsRoot ifTrue:[
aStream cr.
aStream nextPutLine:'>>>> repository: ' , cvsRoot , ' <<<<'.
aStream cr; cr.
aStream nextPutLine:' Date Time User Rev File Package'.
prevUser := nil.
prevCvsRoot := cvsRoot.
].
prevUser ~= user ifTrue:[
aStream cr.
prevUser := user.
].
aStream
nextPutAll:recordType; space;
nextPutAll:(date printString paddedTo:10); space; nextPutAll:(time printString paddedTo:5); space;
nextPutAll:(user leftPaddedTo:10); space;
nextPutAll:(rev decimalPaddedTo:8 and:4 at:$. withLeft:(Character space) right:nil); tab;
nextPutAll:(fileName paddedTo:30); space;
nextPutAll:pkg.
"/
"/ for your convenience:
"/ check what the actual version is in the image
"/
clsName notNil ifTrue:[
revInfo := nil.
cls := Smalltalk classNamed:clsName.
(cls notNil and:[(clsRev := cls revision) notNil]) ifTrue:[
rev ~= clsRev ifTrue:[
revInfo := (' current: ' , clsRev)
]
] ifFalse:[
cls isNil ifTrue:[
revInfo := (' current: ** none **')
] ifFalse:[
cls isLoaded ifTrue:[
revInfo := (' current: ** no revision info **')
] ifFalse:[
revInfo := (' current: ** not loaded **')
]
]
].
revInfo notNil ifTrue:[
aStream nextPutAll:revInfo
].
].
aStream cr
].
].
"Created: / 12-09-2006 / 15:18:35 / cg"
!
writeHistoryLogSince:timeGoal filterSTSources:filter filterUser:userFilter filterRepository:repositoryFilter filterModules:moduleFilter to:aStream
"send a full historyLog to some stream.
This walks over all possible repository roots."
self
writeHistoryLogSince:timeGoal
filterSTSources:filter
filterUser:userFilter
filterRepository:repositoryFilter
filterModules:moduleFilter
filterProjects:nil
to:aStream
"Modified: / 12-09-2006 / 15:19:11 / cg"
!
writeHistoryLogSince:timeGoal filterSTSources:filter filterUser:userFilter filterRepository:repositoryFilter to:aStream
"send a full historyLog to some stream.
This walks over all possible repository roots."
^self
writeHistoryLogSince:timeGoal
filterSTSources:filter
filterUser:userFilter
filterRepository:repositoryFilter
filterModules:nil to:aStream
"Modified: / 17.1.2001 / 13:15:54 / cg"
!
writeHistoryLogSince:timeGoal filterSTSources:filter filterUser:userFilter to:aStream
"send a full historyLog to some stream.
This walks over all possible repository roots."
^ self
writeHistoryLogSince:timeGoal
filterSTSources:filter
filterUser:userFilter
filterRepository:nil
to:aStream
!
writeHistoryLogSince:timeGoal filterSTSources:filter to:aStream
"send a repositories historyLog to some stream"
^ self
writeHistoryLogSince:timeGoal
filterSTSources:filter
filterUser:nil
filterRepository:nil
to:aStream
"Modified: 12.9.1996 / 02:36:32 / cg"
!
writeHistoryLogSince:timeGoal to:aStream
"send a repositories historyLog to some stream"
^ self
writeHistoryLogSince:timeGoal
filterSTSources:true
filterUser:nil
filterRepository:nil
to:aStream
"Created: 13.12.1995 / 10:28:27 / cg"
"Modified: 12.9.1996 / 02:36:38 / cg"
!
writeRevisionLogMessagesFrom:log to:aStream
"helper; send the revisionlog to aStream"
^ self writeRevisionLogMessagesFrom:log withHeader:true to:aStream
"Created: 10.12.1995 / 16:51:30 / cg"
!
writeRevisionLogMessagesFrom:log withHeader:header to:aStream
"helper; send the revisionlog to aStream"
|tags|
header ifTrue:[
"/ (log at:#renamed ifAbsent:false) ifTrue:[
"/ aStream nextPutAll:' Class was probably renamed; revision info is from original class.'.
"/ aStream cr; nextPutAll:' You may have to create a new container for it.'.
"/ aStream cr; cr.
"/ ].
aStream nextPutAll:' Total revisions: '; nextPutLine:(log at:#numberOfRevisions) printString.
aStream nextPutAll:' Newest revision: '; nextPutLine:(log at:#newestRevision) printString.
tags := log at:#symbolicNames ifAbsent:nil.
tags notNil ifTrue:[
aStream nextPutAll:' Stable revision: '; nextPutAll:(tags at:'stable' ifAbsent:'none'); cr.
aStream nextPutAll:' Symbolic names: '; cr.
"sort tags by tag name"
tags := tags associations sort:[:a :b| a key < b key].
tags do:[:eachAssociation|
aStream tab; nextPutAll:eachAssociation key;
nextPutAll:': ';
nextPutAll:eachAssociation value; cr.
]
].
].
(log at:#revisions) do:[:entry |
|logMsg|
aStream cr.
aStream nextPutAll:' revision '; nextPutAll:(entry at:#revision); tab.
aStream nextPutAll:' date: '; nextPutAll:(entry at:#date); tab.
aStream nextPutAll:' author: '; nextPutAll:(entry at:#author); tab.
aStream nextPutAll:' lines: '; nextPutAll:(entry at:#numberOfChangedLines); cr.
logMsg := entry at:#logMessage.
(logMsg isBlank or:[logMsg withoutSeparators = '.']) ifTrue:[
logMsg := '*** empty log message ***'
].
aStream tab; nextPutLine:logMsg.
].
"Created: 16.11.1995 / 13:25:30 / cg"
"Modified: 8.11.1996 / 23:52:48 / cg"
"Modified: 27.11.1996 / 18:26:30 / stefan"
!
writeRevisionLogOf:aClass fromRevision:rev1 toRevision:rev2 to:aStream
"extract a classes log and append it to aStream."
|log |
log := self revisionLogOf:aClass fromRevision:rev1 toRevision:rev2.
log isNil ifTrue:[
aStream cr; nextPutAll:' ** No revision log available **'.
^ false
].
self writeRevisionLogMessagesFrom:log to:aStream.
^ true
"
SourceCodeManager writeRevisionLogOf:Array fromRevision:'1.40' toRevision:'1.43' to:Transcript
"
"Created: 6.11.1995 / 18:56:00 / cg"
"Modified: 14.2.1997 / 21:11:57 / cg"
!
writeRevisionLogOf:aClass to:aStream
"extract a classes log and append it to aStream."
^ self
writeRevisionLogOf:aClass fromRevision:nil toRevision:nil to:aStream
"
SourceCodeManager writeRevisionLogOf:Array to:Transcript
"
! !
!AbstractSourceCodeManager class methodsFor:'subclass responsibility'!
reportHistoryLogSince:timeGoal filterSTSources:filter filterUser:userFilter
filterRepository:repositoryFilter filterModules:moduleFilter inTo:aBlock
^ self subclassResponsibility
! !
!AbstractSourceCodeManager class methodsFor:'testing'!
isCVS
^ false
"Created: / 16-08-2006 / 10:58:27 / cg"
!
isExperimental
^ false
"Created: / 16-08-2006 / 11:22:47 / cg"
!
isSharedImage
^ false
"Created: / 08-11-2006 / 18:54:57 / cg"
!
isStore
^ false
"Created: / 16-08-2006 / 10:59:26 / cg"
! !
!AbstractSourceCodeManager class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic3/AbstractSourceCodeManager.st,v 1.203 2006-11-08 18:52:02 cg Exp $'
! !
AbstractSourceCodeManager initialize!