"
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.
"
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 one of:
STX_TMPPATH/stx_sourceCache
TMPPATH/stx_sourceCache
TMPDIR/stx_sourceCache
/tmp/stx_sourceCache.
whichever variable is first found to be nonEmpty."
|path|
path := OperatingSystem getEnvironment:'STX_TMPPATH'.
path isNil ifTrue:[
path := OperatingSystem getEnvironment:'TMPPATH'.
path isNil ifTrue:[
path := OperatingSystem getEnvironment:'TMPDIR'.
path isNil ifTrue:[
path := '/tmp'
]
]
].
CacheDirectoryName := path , '/stx_sourceCache'.
"Modified: 12.9.1996 / 02:27:48 / cg"
!
initialize
"setup for no caching and no workTree"
CachingSources := UseWorkTree := false.
CacheDirectoryName := WorkTreeDirectoryName := ''.
"Created: 16.12.1995 / 15:41:00 / cg"
"Modified: 12.9.1996 / 02:28:11 / cg"
! !
!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"
!
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
|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"
!
writeHistoryLogSince:timeGoal filterSTSources:filter filterUser:userFilter to:aStream
"send a full historyLog to some stream.
Must be implemented by a concrete subclass."
^ self subclassResponsibility
"Modified: 14.2.1997 / 21:13:51 / cg"
! !
!AbstractSourceCodeManager class methodsFor:'private'!
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
"given a full path as in an RCS header, extract the directory (i.e. package)."
|path idx|
path := self pathInRepositoryFrom:containerPath.
path notNil ifTrue:[
idx := path indexOf:(Filename separator).
idx ~~ 0 ifTrue:[
path := path copyFrom:(idx + 1)
].
^ path asFilename directoryName
].
^ nil
"
SourceCodeManager directoryFromContainerPath:'/files/CVS/stx/libbasic/Array.st'
"
"Created: 25.11.1995 / 18:42:20 / cg"
"Modified: 13.12.1995 / 13:06:15 / cg"
!
filenameFromContainerPath:containerPath
"given some path as present in an RCS Header string, extract the containers
name.
OBSOLETE - this is no longer used."
|top rest|
containerPath notNil ifTrue:[
top := self repositoryTopDirectory.
top notNil ifTrue:[
(containerPath startsWith:(top , '/')) ifTrue:[
rest := containerPath copyFrom:(top size + 2).
^ rest asFilename baseName
].
(containerPath startsWith:(top)) ifTrue:[
rest := containerPath copyFrom:(top size + 1).
^ rest asFilename baseName
]
]
].
^ containerPath
"Created: 25.11.1995 / 18:42:34 / cg"
"Modified: 11.11.1996 / 16:04:39 / cg"
!
moduleFromContainerPath:containerPath
"given a full path as in an RCS header, extract the module."
|path idx|
path := self pathInRepositoryFrom:containerPath.
path notNil ifTrue:[
idx := path indexOf:(Filename separator).
idx == 0 ifTrue:[^ path].
^ path copyTo:(idx - 1)
].
^ nil
"
SourceCodeManager moduleFromContainerPath:'/files/CVS/stx/libbasic/Array.st'
"
"Created: 25.11.1995 / 18:42:20 / cg"
"Modified: 13.12.1995 / 13:06:03 / 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"
^ info at:#directory.
"Created: 6.2.1996 / 17:26:23 / cg"
"Modified: 12.9.1996 / 02:32:19 / cg"
!
pathInRepositoryFrom:containerPath
"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 notNil ifTrue:[
top := self repositoryTopDirectory.
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 no 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'
SourceCodeManager pathInRepositoryFrom:'/phys/ibm/CVS/stx/libbasic/Array.st'
"
"Created: 25.11.1995 / 18:42:20 / cg"
"Modified: 10.1.1997 / 15:13:25 / 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:[
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"
|cls binaryInfo revInfo actualSourceFileName classFileNameBase
newInfo container expectedFileName
directoryFromRev moduleFromRev fileNameFromRev directoryFromBin moduleFromBin|
cls := aClass.
cls isMeta ifTrue:[
cls := cls soleInstance
].
newInfo := IdentityDictionary new.
"/
"/ the info given by the classes source ...
"/
revInfo := aClass revisionInfo.
revInfo notNil ifTrue:[
revInfo keysAndValuesDo:[:key :value |
newInfo at:key put:value
]
].
"/
"/ the info given by the classes binary ...
"/ if present, we better trust that one.
"/ however, it only contains partial information (directory & module).
"/ (but is available even without a source)
"/
binaryInfo := cls packageSourceCodeInfo.
binaryInfo notNil ifTrue:[
binaryInfo keysAndValuesDo:[:key :value |
newInfo at:key put:value
]
].
"/
"/ no information
"/
(binaryInfo isNil and:[revInfo isNil]) ifTrue:[
('SourceCodeManager [warning]: class `' , aClass 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.
newInfo at:#directory put:(directoryFromRev := self directoryFromContainerPath:container).
newInfo at:#module put:(moduleFromRev := self moduleFromContainerPath:container).
fileNameFromRev := container asFilename baseName.
"/ fileNameFromRev := self filenameFromContainerPath:container.
newInfo at:#fileName put:(fileNameFromRev copyWithoutLast:2).
binaryInfo notNil ifTrue:[
(binaryInfo includesKey:#directory) ifTrue:[
directoryFromBin := binaryInfo at:#directory.
moduleFromBin := binaryInfo at:#module.
(directoryFromBin ~= directoryFromRev
or:[moduleFromBin ~= moduleFromRev]) ifTrue:[
(directoryFromRev isNil or:[moduleFromRev isNil]) ifTrue:[
directoryFromBin ~= 'no package' ifTrue:[
('SourceCodeManager [info]: using binary info: '
, moduleFromBin , '/' , directoryFromBin
) infoPrintCR.
newInfo at:#directory put:directoryFromBin.
newInfo at:#module put:moduleFromBin.
]
] ifFalse:[
directoryFromBin ~= 'no package' ifTrue:[
('SourceCodeManager [warning]: conflicting source infos (binary: '
, moduleFromBin , '/' , directoryFromBin
, ' vs. source:'
, moduleFromRev , '/' , directoryFromRev
, ')') infoPrintCR.
]
]
]
]
].
]
].
"/
"/ the filename I'd expect from its name ...
"/
aClass owningClass notNil ifTrue:[
classFileNameBase := Smalltalk fileNameForClass:aClass topOwningClass
] ifFalse:[
classFileNameBase := Smalltalk fileNameForClass:aClass.
].
(newInfo includesKey:#fileName) ifFalse:[
newInfo at:#fileName put:(classFileNameBase , '.st')
].
"/ guess on the container
container isNil ifTrue:[
(newInfo includesKey:#directory) ifTrue:[
(newInfo includesKey:#module) ifTrue:[
(newInfo includesKey:#module) ifTrue:[
container := (newInfo at:#module)
, '/'
, (newInfo at:#directory)
, '/'
, classFileNameBase , '.st,v'.
]
]
]
].
container notNil ifTrue:[
newInfo at:#repositoryPathName put:container.
].
"/ check ..
revInfo notNil ifTrue:[
actualSourceFileName := revInfo at:#fileName ifAbsent:nil.
actualSourceFileName notNil ifTrue:[
expectedFileName := classFileNameBase , '.st'.
actualSourceFileName ~= expectedFileName ifTrue:[
('SourceCodeManager [warning]: source of class ' , aClass 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 copyWithoutLast:3
]
]
].
newInfo at:#classFileNameBase put:classFileNameBase.
^ newInfo
"Created: 25.11.1995 / 12:40:19 / cg"
"Modified: 19.9.1997 / 10:39:26 / 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|
tempDir := (Filename newTemporaryIn:nil) makeDirectory; yourself.
[
|aStream|
tempFile := tempDir construct:classFileName.
aStream := tempFile writeStream.
aStream isNil ifTrue:[
'SOURCEMGR: temporary fileout failed' errorPrintCR.
^ false
].
Method flushSourceStreamCache.
Class fileOutErrorSignal handle:[:ex |
'SOURCEMGR: fileout failed.' errorPrintCR.
'SOURCEMGR: reason: ' errorPrint. ex errorString printCR.
aStream close.
^ false
] do:[
aClass fileOutOn:aStream withTimeStamp:false.
].
aStream close.
tempFile exists ifFalse:[
'SOURCEMGR: temporary fileout failed' errorPrintCR.
^ false
].
ok := self
checkinClass:aClass
fileName:classFileName
directory:packageDir
module:moduleDir
source:(tempFile name)
logMessage:logMessage
force:force.
^ ok
] valueNowOrOnUnwindDo:[
tempDir recursiveRemove
].
^ false
"
SourceCodeManager checkinClass:Array
"
"Modified: 12.7.1996 / 23:38:36 / cg"
"Created: 11.9.1996 / 16:15:17 / cg"
"Modified: 25.9.1997 / 12:16:00 / stefan"
!
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:[
('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
checkinClass:aClass
fileName:classFileName
directory:packageDir
module:moduleDir
logMessage:logMessage
"
SourceCodeManager checkinClass:Array logMessage:'foo'
"
"Created: 6.11.1995 / 18:56:00 / cg"
"Modified: 10.1.1997 / 17:26:48 / 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."
|cls sourceInfo classFileName packageDir moduleDir s m components|
cls := Smalltalk classNamed:aClassName.
cls notNil ifTrue:[
sourceInfo := self sourceInfoOfClass:cls.
].
sourceInfo notNil ifTrue:[
packageDir := self packageFromSourceInfo: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.
moduleDir := 'stx'.
].
packageDir isNil ifTrue:[
'SourceCodeManager [warning]: could not extract packageDir' errorPrintCR.
^ nil
].
s := self
streamForClass:nil
fileName:classFileName
revision:#newest
directory:packageDir
module:moduleDir
cache:false.
s isNil ifTrue:[
"/ guessed moduleDir ?
sourceInfo isNil ifTrue:[
components := Filename concreteClass 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: 8.9.1997 / 00:21:27 / 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 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:[^ nil].
packageDir := self packageFromSourceInfo: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: 10.1.1997 / 15:13:32 / cg"
! !
!AbstractSourceCodeManager class methodsFor:'source code administration'!
getExistingContainersInModule:aModule package:aPackage
"{ Pragma: +optSpace }"
"return a collection containing the names of existing containers"
^ self subclassResponsibility
"Modified: / 29.1.1997 / 18:57:29 / cg"
"Created: / 20.5.1998 / 19:49:12 / 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"
!
getExistingPackagesInModule:aModule
"{ Pragma: +optSpace }"
"return a collection containing the names of existing packages"
^ self subclassResponsibility
"Modified: / 29.1.1997 / 18:57:29 / cg"
"Created: / 20.5.1998 / 19:38:34 / 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."
|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: 10.1.1997 / 13:30:36 / cg"
!
revisionInfoFromRCSString:aString
"{ Pragma: +optSpace }"
"return a dictionary filled with revision info.
This extracts the relevant info from aString."
|words info nm mgr|
info := IdentityDictionary new.
words := aString asCollectionOfWords.
words notEmpty ifTrue:[
"/
"/ supported formats:
"/
"/ $-Header: pathName rev date time user state $
"/ $-Revision: rev $
"/ $-Id: fileName rev date time user state $
"/
((words at:1) = '$Header:') ifTrue:[
nm := words at:2.
info at:#repositoryPathName put:nm.
(nm endsWith:',v') ifTrue:[
nm := nm copyWithoutLast:2
].
info at:#fileName put:nm asFilename baseName.
words size > 2 ifTrue:[
(words at:3) = '$' ifFalse:[
info at:#revision put:(words at:3).
(words at:4) = '$' ifFalse:[
info at:#date put:(words at:4).
info at:#time put:(words at:5).
info at:#user put:(words at:6).
info at:#state put:(words at:7).
]
].
].
^ info
].
((words at:1) = '$Revision:') ifTrue:[
info at:#revision put:(words at:2).
^ info
].
((words at:1) = '$Id:') ifTrue:[
info at:#fileName put:(words at:2).
info at:#revision put:(words at:3).
info at:#date put:(words at:4).
info at:#time put:(words at:5).
info at:#user put:(words at:6).
info at:#state put:(words at:7).
^ info
].
].
^ nil
"
SourceCodeManager revisionInfoFromString:'$Revision: 1.86 $'
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"
!
revisionLogInFile: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"
!
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 packageFromSourceInfo: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: 6.11.1995 / 18:56:00 / cg"
"Modified: 10.1.1997 / 13:30:00 / 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 to:aStream
"send a repositories historyLog to some stream"
self writeHistoryLogSince:timeGoal filterSTSources:filter filterUser: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 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"
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.
].
(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).
aStream cr.
logMsg := entry at:#logMessage.
(logMsg isEmpty or:[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 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:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic3/AbstractSourceCodeManager.st,v 1.86 1998-05-20 17:49:23 cg Exp $'
! !
AbstractSourceCodeManager initialize!