--- a/CVSSourceCodeManager.st Wed Dec 10 09:34:19 2003 +0100
+++ b/CVSSourceCodeManager.st Fri Dec 12 16:08:19 2003 +0100
@@ -1,3 +1,28 @@
+"
+ 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' }"
+
+AbstractSourceCodeManager subclass:#CVSSourceCodeManager
+ instanceVariableNames:''
+ classVariableNames:'Verbose CVSRoot CVSWorkDirectory RemoteCVS CVSBinDir
+ CVSModuleRoots CMD_checkout CVSTempDir DisabledModules'
+ poolDictionaries:''
+ category:'System-SourceCodeManagement'
+!
+
+!CVSSourceCodeManager class methodsFor:'documentation'!
+
+copyright
"
COPYRIGHT (c) 1995 by Claus Gittinger
All Rights Reserved
@@ -9,22 +34,4344 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
-"{ Package: 'unknown' }"
-
-AbstractSourceCodeManager subclass:#CVSSourceCodeManager
- instanceVariableNames:''
- classVariableNames:'Verbose CVSRoot CVSWorkDirectory RemoteCVS CVSBinDir
- CVSModuleRoots CMD_checkout CVSTempDir DisabledModules'
- poolDictionaries:''
- category:'System-SourceCodeManagement'
+!
+
+documentation
+"
+ SourceCodeManager which accesses the sourcecode through cvs.
+ It requires the shell environment variable CVSROOT to be set
+ to the top of the repository tree. (or alternatively, the CVSRoot
+ variable being set by a private.rc file).
+ Under that top, for each module (especially the stx module itself),
+ a subdirectory containing that modules directories must exist.
+
+ If not specified otherwise, the module defaults to 'stx'.
+ If a class has its home in another module, it has to be compiled
+ with a corresponding entry in the package string (see below).
+ Within a module, classes are organized in classlibraries, and the corresponding
+ source code is found in various subdirectories of CVSROOT. The directories
+ name can also be provided by the package string - if not, it defaults to the
+ libraries name.
+ The package string controls all this, and is REQUIRED in order for the sourceCodeManager
+ to be able to retrieve a classes source.
+ The package strings format is:
+ '...any infotext....(sourceCodeInfo)'
+ the sourceCOdeInfo consists of multiple entries, separated by colons.
+ The following formats are allowed:
+ (libraryName) - module defaults to 'stx'; directory to the name of the library
+ (foo/bar/x) - module defaults to 'stx'; dir is 'foo/bar/x'; library name defaults to x
+ (module:directory:libname) - specifies all components
+ The first formats are intermediate, for backward compatibility. We urge everyone
+ to use the last format (by changing the Make.proto files and add a -P flag to
+ the stc compiler flags (see libbasic/Make.proto as an example).
+
+ Notice, that the sourceCodeManager is (currently) only consulted, if no
+ source subdirectory exists, or no source file is found there. If it does exist,
+ that one is supposed to contain an up-to-date version of the classes source
+ (this is temporary - in the future the probe order will be reversed, trying
+ the source repository first).
+ The source directory is required for systems which do NO source code control.
+
+ Setup:
+ - make certain, that the commands 'cvs' and 'co' are available on your system.
+ - add setup for the CVSROOT environment variable to your .bashrc / .login / .profile
+ - Make certain that either no local source directory exists, or it is empty or it contains
+ only source code for files NOT found in the repository (this will not be required in future versions).
+
+ Caveat:
+ currently, the rcs container is accessed directly, since cvs mangles the files ident-string and
+ thus does not correctly recreate the original file (all source is offset by some characters w.r.t. the
+ compiled file).
+ Therefore, sevrer-mode CVS is not supported.
+
+ [class variables:]
+ CVSTempDir <String | nil> where a directory tree is
+ generated temporarily for checkin/checkout
+ (default is nil -> current dir)
+
+ CVSRoot <String> the CVS root. Imported from the
+ CVSROOT shell variable.
+
+ RemoteCVS <Boolean> if true, remote CVS access is used
+ (i.e. via a socket to a CVS server).
+ if false, disk access is used;
+ files in CVSRoot must be accessable.
+
+ CVSWorkDirectory not yet supported/implemented.
+ PLANNED: name of a directory hierarchy,
+ which is kept in sync with the current
+ version.
+
+ CVSBinDir where the CVS commands are found
+
+ CVSModuleRoots <Directory> per-module roots.
+ If empty, or no entry is found for a
+ module is found, CVSRoot is used.
+ Otherwise, specifies a per-module CVSRoot.
+ (allows multiple CVS hierarchies)
+
+ [author:]
+ Claus Gittinger
+
+ [see also:]
+ ( cvs manual page :man: cvs )
+ ( Coding style used in Smalltalk/X classes :html: programming/codingStyle.html )
+
+ [restrictions:]
+ commercial version only
+"
+!
+
+examples
+"
+ Default setup:
+ This setup accesses all sources from a single repository: /files/CVS.
+ Actually, this is the setup as used within eXept for development.
+
+ CVSSourceCodeManager initializeForRepository:'/files/CVS'.
+
+
+ Dual repository setup:
+ This accesses all ST/X standard classes' source from the /files/CVS
+ repository, while your private classes are created in and accessed from
+ '/files/myCVS'.
+ This setup is useful, if you need revision management on the
+ ST/X standard classes as well as for your own classes.
+ In order to do this, you should (manually) check in all ST/X classes
+ into a private repository WHILE preserving the original revision numbers.
+ A shell-procedure similar to:
+
+ for i in lib*/*.st
+ do
+ id=`ident $i`
+ set $id
+ rev=$3
+ ci -r$rev <CVSDIR>/$i $i
+ done
+
+ should acomplish this.
+ Now, that you have all ST/X files in your own repository (and with the
+ original revision numbers), access is possible by defining CVSROOT
+ as above. However, in order to have your own files being stored in
+ another repository, you have to give a per-module repository.
+
+ This defines the default repository (for your containers):
+
+ CVSSourceCodeManager initializeForRepository:'/files/myCVS'.
+
+ and this specifies a repository for all standard ST/X classes (in the stx module):
+
+ CVSSourceCodeManager repositoryName:'/files/CVS' forModule:'stx'
+
+ Dual repository setup for eXept customers with a full licence
+ (these can access our in-house master repository, for convenient software update
+ and uploading):
+ All class sourcees under the 'stx' module (i.e. packageID is 'stx:*') can be accessed
+ from the eXept cvs server (i.e. CVSROOT for them is :pserver:userName@exept.de:/files/CVS/stc).
+ All local classes should be maintained in and accessed from a local cvs repository
+ such as '/files/myCVS'.
+
+ Then, tell the CVSSourceCodeManager about this;
+ first the default repository:
+
+ CVSSourceCodeManager initializeForRepository:'/files/myCVS'.
+
+ and the repository for all standard ST/X classes (in the stx module):
+
+ CVSSourceCodeManager repositoryName:':pserver:userName@exept.de:/files/CVS' forModule:'stx'
+"
+! !
+
+!CVSSourceCodeManager class methodsFor:'initialization'!
+
+forgetDisabledModules
+ DisabledModules := nil.
+!
+
+initCommands
+ CMD_checkout := 'cvs -n checkout %1'.
+!
+
+initialize
+ "check if $CVSROOT (the shell variable) or CVSRoot (the smalltalk global)
+ is set, check if cvs commands can be executed and install myself as the
+ SourceCodeManager if this works out ok"
+
+ | s f top ok triedPath cvsCmd cmdName |
+
+ DisabledModules := nil.
+
+ "/ where a temporary directory hierarchy is
+ "/ created for checkin/checkout
+
+ CVSTempDir ifNil:[
+ CVSTempDir := Filename tempDirectory pathName
+ ].
+
+ "/
+ "/ if CVSROOT is non-empty and both cvs and co are available
+ "/ as commands, assume this system uses a cvs source code management.
+ "/
+ CVSRoot ifNil:[
+ CVSRoot := OperatingSystem getEnvironment:'CVSROOT'
+ ].
+
+ CVSRoot ifNil:[
+ "disabled since $CVSROOT is not set"
+ ^ self
+ ].
+
+ OperatingSystem isMSDOSlike ifTrue:[
+ cvsCmd := 'cvs.exe'
+ ] ifFalse:[
+ cvsCmd := 'cvs'
+ ].
+
+ CVSBinDir size > 0 ifTrue:[
+ OperatingSystem isMSDOSlike ifTrue:[
+ cmdName := CVSBinDir asFilename constructString:cvsCmd.
+ ( OperatingSystem canExecuteCommand:cmdName) ifFalse:[
+ CVSBinDir := ''.
+ ] ifTrue:[
+ CVSBinDir := CVSBinDir asFilename pathName
+ ]
+ ]
+ ].
+
+ CVSBinDir size == 0 ifTrue:[
+ CVSBinDir := ''.
+ (ok := OperatingSystem canExecuteCommand:cvsCmd) ifFalse:[
+ "/ mhmh - no cvs;
+
+ OperatingSystem isUNIXlike ifTrue:[
+ triedPath := #( '/usr/local/bin' ).
+ ] ifFalse:[
+ OperatingSystem isMSDOSlike ifTrue:[
+ triedPath := Array with:'c:\bin'
+ with:(Filename currentDirectory pathName)
+ with:(OperatingSystem stxBinDirPath ? 'c:\windows').
+ ] ifFalse:[
+ triedPath := #()
+ ]
+ ].
+
+ triedPath do:[:eachTriedDir |
+ ok ifFalse:[
+ (OperatingSystem canExecuteCommand:(eachTriedDir asFilename constructString:cvsCmd)) ifTrue:[
+ ok := true.
+ CVSBinDir := eachTriedDir.
+ ]
+ ]
+ ].
+ ].
+ ] ifFalse:[
+ ok := OperatingSystem canExecuteCommand:(CVSBinDir asFilename constructString:cvsCmd).
+ ].
+
+ ok ifFalse:[
+ 'CVSSourceCodeManager [warning]: disabled since no >> cvs << command found' infoPrintCR.
+ ^ self
+ ].
+
+"/ (OperatingSystem canExecuteCommand:(CVSBinDir , 'co')) ifFalse:[
+"/ 'CVSSourceCodeManager [warning]: limited functionality - no >> co << command found' infoPrintCR.
+"/ ].
+"/ (OperatingSystem canExecuteCommand:(CVSBinDir , 'rlog')) ifFalse:[
+"/ 'CVSSourceCodeManager [warning]: limited functionality - no >> rlog << command found' infoPrintCR.
+"/ ].
+"/ (OperatingSystem canExecuteCommand:(CVSBinDir , 'patch')) ifFalse:[
+"/ 'CVSSourceCodeManager [warning]: limited functionality - no >> patch << command found' infoPrintCR.
+"/ ].
+
+ RemoteCVS := true.
+ UseWorkTree := false.
+
+ CacheDirectoryName ifNil:[
+ self initCacheDirPath.
+ ].
+ CachingSources ifNil:[
+ CachingSources := true.
+ ].
+
+ "/
+ "/ check if there is an stx directory there
+ "/
+ ((f := CVSRoot asFilename) isDirectory
+ and:[(top := f construct:'stx') isDirectory
+ and:[top isReadable]]) ifTrue:[
+ RemoteCVS := false
+ ].
+
+ Smalltalk at:#SourceCodeManager put:self.
+ DefaultManager := self.
+
+ ('CVSSourceCodeManager [info]: repository CVSROOT is ''' , CVSRoot , '''.') infoPrintCR.
+ RemoteCVS ifTrue:[
+ 'CVSSourceCodeManager [info]: assume remote CVS mode (no stx found in CVSROOT)' infoPrintCR.
+ ^ self
+ ].
+
+ "/
+ "/ optionally set the WorkTreeDirectoryName from $STX_WORKTREE;
+ "/ if non-nil, a working tree is kept there
+ "/ and updated/commited files are not removed.
+ "/ If you use a regular (make-) tree,
+ "/ set WorkTreeDirectoryName (or the environment variable) to that.
+ "/
+ "/ this is not yet finished.
+ "/
+ s := OperatingSystem getEnvironment:'STX_WORKTREE'.
+ s notNil ifTrue:[
+ WorkTreeDirectoryName := s.
+ UseWorkTree := true.
+ ]
+
+ "
+ AbstractSourceCodeManager initialize
+ CVSSourceCodeManager initialize
+ "
+
+ "
+ CVSRoot := '/files/CVS'.
+ AbstractSourceCodeManager initialize.
+ CVSSourceCodeManager initialize.
+ "
+
+ "Created: / 4.11.1995 / 19:14:38 / cg"
+ "Modified: / 19.12.1995 / 14:25:46 / stefan"
+ "Modified: / 5.12.2001 / 18:52:00 / cg"
+!
+
+initializeForRepository:aDirectoryName
+ "set the global CVSROOT directory (i.e. the repositories name).
+ And reinitialize.
+ Can be used from the launcher to change/configure the repository."
+
+ self repositoryName:aDirectoryName.
+ AbstractSourceCodeManager initialize.
+ CVSSourceCodeManager initialize.
+
+ "
+ CVSSourceCodeManager initializeForRepository:'/files/CVS'
+ CVSSourceCodeManager initializeForRepository:'ibm:/files/CVS'
+ "
+
+ "Created: / 13.8.1997 / 17:20:57 / cg"
+ "Modified: / 25.9.1997 / 12:28:05 / stefan"
+ "Modified: / 2.11.1997 / 17:08:27 / cg"
+! !
+
+!CVSSourceCodeManager class methodsFor:'accessing'!
+
+cvsBinDirectory
+ "return the name of the bin repository.
+ Thats the directory, where the cvs / cvs.exe command is found."
+
+ ^ CVSBinDir
+!
+
+cvsBinDirectory:aString
+ "set the name of the bin repository.
+ Thats the directory, where the cvs / cvs.exe command is found."
+
+ aString isEmpty ifTrue:[
+ CVSBinDir := aString
+ ] ifFalse:[
+ CVSBinDir := aString asFilename pathName.
+ (CVSBinDir endsWith:Filename separator) ifTrue:[
+ CVSBinDir := CVSBinDir copyWithoutLast:1.
+ ]
+ ].
+!
+
+repositoryName
+ "return the name of the global repository.
+ This is used, if no per-module repository is defined."
+
+ ^ CVSRoot
+
+ "Created: 14.9.1996 / 13:22:05 / cg"
+ "Modified: 19.9.1997 / 06:12:02 / cg"
+!
+
+repositoryName:aDirectoryName
+ "set the name of the repository;
+ thats the name of the global CVSROOT directory, which is used
+ if no specific repository was defined for a module.
+ Can be used from an rc-script, to override the CVSROOT shell
+ variable setting."
+
+ DisabledModules := nil.
+ CVSRoot := aDirectoryName.
+
+ "Created: 14.9.1996 / 13:22:24 / cg"
+ "Modified: 19.9.1997 / 06:10:31 / cg"
+!
+
+repositoryName:aRepositoryName forModule:aModuleName
+ "set the CVSROOT directory which provides the sources for all
+ classes in a particular module.
+ This can be used from an rc-script, to specify a repository
+ for a particular module.
+ If left unspecified, the global (i.e. fallBack) repository is used."
+
+ DisabledModules := nil.
+ CVSModuleRoots isNil ifTrue:[
+ CVSModuleRoots := Dictionary new.
+ ].
+ CVSModuleRoots at:aModuleName put:aRepositoryName
+
+ "Modified: 19.9.1997 / 06:09:40 / cg"
+!
+
+repositoryNameForModule:aModuleName
+ "return the CVSROOT directory which provides the sources for all
+ classes in a particular module.
+ Nil is returned for unspecified moduleRoots; in this case,
+ the global (i.e. fallBack) repository will be used for source access."
+
+ CVSModuleRoots isNil ifTrue:[^nil].
+ ^ CVSModuleRoots at:aModuleName ifAbsent:nil.
+
+ "Modified: 19.9.1997 / 06:09:40 / cg"
+ "Created: 19.9.1997 / 06:13:06 / cg"
+!
+
+repositoryNamesPerModule
+ "return the dictionary, which associates CVSRoots to module names.
+ If no entry is contained in this dictionary for some module,
+ the default cvsRoot (CVSRoot) will be used."
+
+ ^ CVSModuleRoots ? (Dictionary new)
+!
+
+repositoryNamesPerModule:aDictionary
+ "set the dictionary, which associates CVSRoots to module names.
+ If no entry is contained in this dictionary for some module,
+ the default cvsRoot (CVSRoot) will be used."
+
+ CVSModuleRoots := aDictionary
+! !
+
+!CVSSourceCodeManager class methodsFor:'private'!
+
+checkOut:relativeFilename module:moduleDir in:tempdir
+ "checkout realtiveFilename in tempdir"
+
+ |cmd|
+
+ cmd := 'checkout -l ' , relativeFilename.
+ ^ self
+ executeCVSCommand:cmd
+ module:moduleDir
+ inDirectory:tempdir name
+ log:false
+
+
+ "
+ self checkOut:'stx/libbasic/Integer.st' asFilename in:'/tmp' asFilename
+ "
+
+ "Created: / 18.1.2000 / 20:30:01 / cg"
+ "Modified: / 18.1.2000 / 20:35:06 / cg"
+!
+
+checkinTroubleDialog:title message:message log:log abortable:abortable option:optionTitle
+ "trouble checking in - open a dialog"
+
+ ^ self
+ checkinTroubleDialog:title
+ message:message
+ log:log
+ abortable:abortable
+ option:optionTitle
+ option2:nil
+
+ "Created: 10.12.1995 / 17:34:33 / cg"
+ "Modified: 12.9.1996 / 02:39:06 / cg"
+!
+
+checkinTroubleDialog:title message:message log:log abortable:abortable option:optionTitle option2:optionTitle2
+ ^self
+ checkinTroubleDialog:title
+ message:message
+ log:log
+ abortable:abortable
+ option:optionTitle
+ option2:optionTitle2
+ option3:nil
+!
+
+checkinTroubleDialog:title message:message log:log abortable:abortable option:optionTitle option2:optionTitle2 option3:optionTitle3
+ "trouble checking in - open a dialog"
+
+ |l box list listView optionPressed option2Pressed option3Pressed|
+
+ l := log collect:[:line | line withTabsExpanded].
+ list := SelectionInList with:l.
+
+ box := Dialog new.
+ box label:(title).
+
+ (box addTextLabel:message) borderWidth:0.
+
+ listView := SelectionInListView on:list.
+ listView disable.
+ listView height:200.
+ box addComponent:(HVScrollableView forView:listView miniScrollerH:true) tabable:false.
+ box addVerticalSpace.
+
+ abortable ifTrue:[
+ box addAbortButton
+ ].
+ optionTitle notNil ifTrue:[
+ box addOkButton:(Button label:optionTitle action:[optionPressed := true. box hide]).
+ ].
+ optionTitle2 notNil ifTrue:[
+ box addOkButton:(Button label:optionTitle2 action:[option2Pressed := true. box hide]).
+ ].
+ optionTitle3 notNil ifTrue:[
+ box addOkButton:(Button label:optionTitle3 action:[option3Pressed := true. box hide]).
+ ].
+ box addOkButton.
+
+ box extent:(box preferredExtent).
+ box minExtent:box extent.
+ box maxExtent:box extent.
+
+ box open.
+
+ box destroy.
+ optionPressed == true ifTrue:[^ #option].
+ option2Pressed == true ifTrue:[^ #option2].
+ option3Pressed == true ifTrue:[^ #option3].
+ ^ box accepted
+
+ "Created: 9.9.1996 / 19:12:45 / cg"
+ "Modified: 12.9.1996 / 02:39:10 / cg"
+!
+
+createEntryFor:pathInRepository module:aModule in:aDirectory revision:rev date:date special:special overwrite:overwrite
+ "create an CVS/Repository and CVS/Entries entry for filename.
+ If the path does not exist, it will be created
+ If overwrite is true, an existing Entry will be overwritten.
+ "
+
+ |filename cvsRoot cvsDir name entries firstPart s path|
+
+ filename := pathInRepository asFilename.
+ cvsDir := (aDirectory asFilename construct:'CVS') recursiveMakeDirectory.
+ entries := cvsDir construct:'Entries'.
+ name := filename baseName.
+ firstPart := '/', name, '/'.
+
+ s := entries readStreamOrNil.
+ s isNil ifTrue:[
+ "/
+ "/ no Repository yet, create one
+ "/
+ |index root|
+
+ cvsRoot := self getCVSROOTForModule:aModule.
+ "/
+ "/ match for first '/', to get the path portion without :pserver:host:
+ "/
+ index := cvsRoot indexOf:$/.
+ index > 0 ifTrue:[
+ root := cvsRoot copyFrom:(index).
+ ] ifFalse:[
+ root := cvsRoot.
+ ].
+ "/ create Repository
+ "/ (notice, contents must be a Unix filename ...
+
+ s := (cvsDir construct:'Repository') writeStream.
+ path := Filename components:filename directory name.
+ path := path asStringWith:$/.
+ s nextPutLine:(root, '/', path).
+ s close.
+
+ "/ make new Entries file.
+ s := entries writeStream.
+ ] ifFalse:[
+ |newName newStream line|
+
+ newName := Filename newTemporaryIn:cvsDir.
+ newStream := newName writeStream.
+ [(line := s nextLine) notNil] whileTrue:[
+ (line findString:firstPart) ~= 1 ifTrue:[
+ "/ we have found an entry for ourself.
+ "/ If we do not want to overwrite it, clean up everything and return.
+ overwrite ifFalse:[
+ newName remove.
+ newStream close.
+ s close.
+ ^ self
+ ].
+ newStream nextPutLine:line
+ ].
+ ].
+ newName renameTo:entries.
+ s close.
+ s := newStream.
+ ].
+ s nextPutLine:firstPart, rev, '/', date, '/', special, '/'.
+ s close.
+
+ "
+ self createEntryFor:'foo/xxx/yyy' in:'foo/xxx' revision:'1.22' date:'dummy' special:''
+ self createEntryFor:'foo/xxx/yyy' in:'foo/xxx' revision:'3.44' date:'new dummy' special:'special'
+ "
+
+ "Created: / 19.9.1997 / 06:21:02 / cg"
+ "Modified: / 7.1.1998 / 14:15:35 / stefan"
+ "Modified: / 20.8.1998 / 00:12:11 / cg"
+!
+
+createLocalDirectory:packageDir inModule:moduleDir
+ "create a local working directory for module/package.
+ To speed up things, we checkout the file '.cvsignore', to create
+ the whole tree. If the file is not present, we will create it as empty file.
+ Return the name of a temporary directory containing the package"
+
+ ^ self
+ createLocalDirectory:packageDir
+ inModule:moduleDir
+ with:'.cvsignore'
+
+ "
+ self createLocalDirectory:'libbasic' inModule:'stx'
+ "
+
+ "Created: / 23.7.1999 / 19:14:28 / stefan"
+ "Modified: / 26.7.1999 / 17:43:35 / stefan"
+ "Modified: / 18.1.2000 / 20:56:19 / cg"
+!
+
+createLocalDirectory:packageDir inModule:moduleDir with:fileToCheckout
+ "create a local working directory for module/package, and checkout the
+ given file there.
+ Return the name of a temporary directory containing the package, or nil"
+
+ |path absolutePath tempdir workingDir unixPath|
+
+ path := (moduleDir asFilename construct:packageDir) construct:fileToCheckout.
+
+ tempdir := self createTempDirectory:nil forModule:nil.
+ tempdir isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: no tempDir - cannot checkout') errorPrintCR.
+ ^ nil
+ ].
+
+ [
+ OperatingSystem isUNIXlike ifTrue:[
+ unixPath := path name.
+ ] ifFalse:[
+ OperatingSystem isVMSlike ifTrue:[
+ self error:'VMS case not yet implemented'
+ ].
+ unixPath := path name copy replaceAll:$\ with:$/
+ ].
+
+ (self checkOut:unixPath module:moduleDir in:tempdir) ifFalse:[
+ "dummy file does not exist, so create it"
+
+ absolutePath := tempdir construct:path.
+ absolutePath directory recursiveMakeDirectory.
+ "now create the file"
+ (absolutePath writeStream close) isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: cannot create dummy') errorPrintCR.
+ tempdir recursiveRemove.
+ ^ nil.
+ ].
+
+ "now create the dummy file in the repository"
+ (self import:moduleDir in:tempdir) ifFalse:[
+ ('CVSSourceCodeManager [error]: cannot import dummy') errorPrintCR.
+ ].
+
+ "remove the path, so that checkout works"
+ (tempdir construct:moduleDir) recursiveRemove.
+
+ "checkout the dummy, the intermediate directories will be created"
+ (self checkOut:unixPath module:moduleDir in:tempdir) ifFalse:[
+ ('CVSSourceCodeManager [warning]: import failed (to create working dir)') errorPrintCR.
+"/false ifTrue:[
+"/ "/ manually create it
+"/
+"/ (tempdir construct:unixPath) directory recursiveMakeDirectory.
+"/ workingDir := tempdir.
+"/ unixPath asFilename directory components do:[:each |
+"/ self executeCVSCommand:('add ' , each) module:moduleDir inDirectory:workingDir.
+"/ workingDir := workingDir construct:each.
+"/ ].
+"/ (absolutePath writeStream close) isNil ifTrue:[
+"/ ('CVSSourceCodeManager [error]: cannot create dummy') errorPrintCR.
+"/ tempdir recursiveRemove.
+"/ ^ nil.
+"/ ].
+"/ self executeCVSCommand:('add ' , fileToCheckout) module:moduleDir inDirectory:workingDir.
+"/ self executeCVSCommand:('commit ' , fileToCheckout) module:moduleDir inDirectory:workingDir.
+"/
+"/ ^ tempdir
+"/].
+ tempdir recursiveRemove.
+ ^ nil.
+ ].
+ ].
+ ] valueOnUnwindDo:[
+ tempdir recursiveRemove.
+ ].
+
+ ^ tempdir.
+
+ "
+ self createLocalDirectory:'libbasic' inModule:'stx'
+ "
+
+ "Modified: / 26.7.1999 / 17:43:35 / stefan"
+ "Created: / 18.1.2000 / 20:55:52 / cg"
+ "Modified: / 18.1.2000 / 20:56:45 / cg"
+!
+
+createTempDirectory:packageDir forModule:moduleDir
+ "create a temp directory for checking out"
+
+ |tempdir dir|
+
+ "/ if CVSTempDir isNil, use current.
+ tempdir := Filename newTemporaryIn:CVSTempDir.
+ tempdir exists ifTrue:[
+ tempdir recursiveRemove.
+ ].
+ OperatingSystem errorSignal handle:[:ex |
+ 'SourceCodemanager [error]: cannot create temporary directory' errorPrintCR.
+ ^ nil.
+ ] do:[
+ tempdir makeDirectory.
+ ].
+
+ moduleDir notNil ifTrue:[
+ dir := tempdir construct:moduleDir.
+ dir makeDirectory.
+
+ packageDir notNil ifTrue:[
+ dir := dir construct:packageDir.
+ dir recursiveMakeDirectory.
+ ].
+ dir exists ifFalse:[
+ tempdir recursiveRemove.
+ 'SourceCodemanager [error]: cannot create temporary directory' errorPrintCR.
+ ^ nil.
+ ].
+ ].
+ ^ tempdir
+
+ "self createTempDirectory:'fooPackage' forModule:'fooModule'"
+
+ "Created: 9.12.1995 / 19:14:35 / cg"
+ "Modified: 19.12.1995 / 16:13:02 / stefan"
+ "Modified: 18.8.1997 / 19:06:52 / cg"
+!
+
+cvsTimeString:absoluteTime
+ "convert an absoluteTime to a string suitable for the CVS/Entries file:
+
+ 123456789012345678901234
+ Tue Dec 19 20:56:26 1995
+ "
+
+ |date time stream|
+
+ date := absoluteTime asDate.
+ time := absoluteTime asTime.
+ stream := WriteStream on:(String new:24).
+
+ (#('Mon' 'Tue' 'Wed' 'Thu' 'Fri' 'Sat' 'Sun') at:(date dayInWeek)) printOn:stream.
+ stream space.
+
+ (#('Jan' 'Feb' 'Mar' 'Apr' 'May' 'Jun' 'Jul' 'Aug' 'Sep' 'Oct' 'Nov' 'Dec')
+ at:(date month)) printOn:stream.
+ stream space.
+
+ date day printOn:stream.
+ stream space.
+
+ time print24HourFormatOn: stream.
+ stream space.
+
+ date year printOn:stream.
+
+ ^ stream contents
+
+
+ "
+ CVSSourceCodeManager cvsTimeString:(AbsoluteTime now)
+ "
+
+ "Modified: 20.12.1995 / 11:03:32 / stefan"
+!
+
+executeCVSCommand:cvsCommand module:moduleName inDirectory:dir
+ "execute command and prepend cvs command name and global options.
+ if dir ~= nil, execute command in that directory.
+ This also leads to a log-entry to be added to cvs's logfile."
+
+ ^ self
+ executeCVSCommand:cvsCommand
+ module:moduleName
+ inDirectory:dir
+ log:true
+
+ "Modified: / 20.5.1998 / 16:07:28 / cg"
+!
+
+executeCVSCommand:cvsCommand module:moduleName inDirectory:dir log:doLog
+ "execute command and prepend cvs command name and global options.
+ if dir ~= nil, execute command in that directory.
+ The doLog argument, if false supresses a logEntry to be added
+ in the cvs log file (used when reading / extracting history)"
+
+ ^ self
+ executeCVSCommand:cvsCommand module:moduleName inDirectory:dir log:doLog
+ pipe:false
+!
+
+executeCVSCommand:cvsCommand module:moduleName inDirectory:dirArg log:doLog pipe:doPipe
+ "execute command and prepend cvs command name and global options.
+ execute command in the dirArg directory.
+ The doLog argument, if false supresses a logEntry to be added
+ in the cvs log file (used when reading / extracting history)"
+
+ |command cvsRoot rslt ok pathOfDir p dir|
+
+ dir := dirArg asFilename.
+ pathOfDir := dir pathName.
+
+ cvsRoot := self getCVSROOTForModule:moduleName.
+
+ command := CVSBinDir.
+ command size > 0 ifTrue:[
+ (command endsWith:Filename separator) ifFalse:[
+ command := command , (Filename separator asString)
+ ]
+ ].
+ command := command , 'cvs'.
+ (command includes:Character space) ifTrue:[
+ command := '"' , command , '"'
+ ].
+
+ doLog ifFalse:[
+ command := command , ' -l'.
+ ].
+ command := command , ' -d "', cvsRoot, '" ', cvsCommand.
+
+ Verbose == true ifTrue:[
+ ('CVSSourceCodeManager [info]: executing: ' , command , ' [in ' , pathOfDir , ']') infoPrintCR.
+ ].
+
+ doPipe ifTrue:[
+ rslt := PipeStream readingFrom:command inDirectory:pathOfDir.
+ ok := rslt notNil.
+ ] ifFalse:[
+ Processor isDispatching ifFalse:[
+ rslt := ok := OperatingSystem executeCommand:command inDirectory:pathOfDir.
+ ] ifTrue:[
+ p := [
+ rslt := ok := OperatingSystem executeCommand:command inDirectory:pathOfDir.
+ ] fork.
+
+ (p waitUntilTerminatedWithTimeout:300) ifTrue:[
+ ('CVSSourceCodeManager [info]: command timeout: ' , command) errorPrintCR.
+ ^ false
+ ].
+ ].
+ ].
+
+ ok ifFalse:[
+ ('CVSSourceCodeManager [info]: command failed: ' , command) errorPrintCR.
+ ].
+ ^ rslt
+
+ "Modified: / 23.4.1996 / 15:24:00 / stefan"
+ "Created: / 20.5.1998 / 16:06:34 / cg"
+ "Modified: / 19.5.1999 / 10:43:57 / cg"
+!
+
+getCVSROOTForModule:aModuleName
+ "internal: used when accessing a source repository.
+ Return the CVSROOT which provides the sources for a particular module.
+ If no specific root was defined for that module, return the value of
+ the global (fallBack) CVSRoot.
+ Nil is returned if no repository is available."
+
+ |root|
+
+ CVSModuleRoots isNil ifTrue:[^ CVSRoot].
+ aModuleName isNil ifTrue:[^ CVSRoot].
+ root := CVSModuleRoots at:aModuleName ifAbsent:nil.
+ ^ root ? CVSRoot
+
+ "Created: / 19.9.1997 / 06:18:07 / cg"
+ "Modified: / 20.5.1998 / 16:30:12 / cg"
+!
+
+getCVSROOTsPerModule
+ "return a dictionary, which associates CVSRoots to modules"
+
+ ^ CVSModuleRoots ? #()
+!
+
+import:moduleDir in:tempdir
+ "import the existing tree in tempdir as repository"
+
+ |cmd|
+
+ cmd := 'import -m "checkin from stx browser" . initialV initialR'.
+ ^ self
+ executeCVSCommand:cmd
+ module:moduleDir
+ inDirectory:tempdir name
+ log:false
+
+
+ "
+ |f d|
+ f := 'stefan/dummy/fasel'.
+ d := '/tmp/tt' asFilename construct:f.
+ d directory recursiveMakeDirectory.
+ d writeStream close.
+ self import:'stefan' in:'/tmp/tt/stefan' asFilename
+ "
+
+ "Created: / 23.7.1999 / 19:19:34 / stefan"
+ "Modified: / 26.7.1999 / 17:46:29 / stefan"
+ "Modified: / 18.1.2000 / 20:21:32 / cg"
+!
+
+releaseAndRemove:tempdir module:moduleDir outputTo:outputFilename
+ "cleanup; release tree towards cvs and remove the temporary tree"
+
+ |cmd redirect|
+
+ outputFilename isNil ifTrue:[
+ OperatingSystem isMSDOSlike ifTrue:[
+ redirect := 'NUL'
+ ] ifFalse:[
+ redirect := '/dev/null'
+ ]
+ ] ifFalse:[
+ redirect := outputFilename name
+ ].
+
+ "/
+ "/ release it towards cvs
+ "/
+ cmd := '-l release > ' , redirect.
+ (self
+ executeCVSCommand:cmd
+ module:moduleDir
+ inDirectory:tempdir name
+ log:false
+ ) ifFalse:[
+"/ 'CVSMGR: failed to release: ' errorPrint. cmd errorPrintNL.
+ ].
+
+ tempdir recursiveRemove.
+
+ "Modified: / 23.4.1996 / 14:29:49 / stefan"
+ "Created: / 19.9.1997 / 06:28:02 / cg"
+ "Modified: / 20.5.1998 / 16:44:07 / cg"
+ "Modified: / 3.9.1999 / 14:51:29 / ps"
+!
+
+repositoryTopDirectory
+ "return the top of the repository. This handles remote CVS connections
+ as well"
+
+ CVSRoot isNil ifTrue:[^ nil].
+ ^ self repositoryTopDirectory:CVSRoot.
+
+ "
+ CVSSourceCodeManager repositoryTopDirectory
+ "
+
+ "Created: / 25.11.1995 / 18:39:19 / cg"
+ "Modified: / 16.1.1998 / 17:33:31 / stefan"
+!
+
+repositoryTopDirectory:aString
+ "return the top of the repository (without remote prefix)"
+
+ |idx|
+
+ idx := aString indexOf:$/.
+ idx <= 1 ifTrue:[
+ ^ aString.
+ ].
+ ^ aString copyFrom:idx.
+
+ "
+ CVSSourceCodeManager repositoryTopDirectory:':pserver:stefan@ibm.exept.de:/archiv/cvs'
+ CVSSourceCodeManager repositoryTopDirectory:'exept:/files/CVS'
+ CVSSourceCodeManager repositoryTopDirectory:'/archiv/cvs'
+ "
+
+ "Modified: / 16.1.1998 / 17:32:03 / stefan"
+!
+
+revisionStringFromLog:log entry:entry forClass:aClass
+ "given a log entry, extract a revision string"
+
+ |oldRev idx special|
+
+ 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: ' , (log at:#container) ,
+ ' ' , (entry at:#revision) ,
+ ' ' , (entry at:#date) ,
+ ' ' , (entry at:#author) ,
+ ' ' , (entry at:#state) ,
+ ' $' ,
+ special
+
+ "Created: 16.9.1996 / 20:24:14 / cg"
+ "Modified: 3.3.1997 / 22:31:51 / cg"
+!
+
+updatedRevisionStringOf:aClass forRevision:newRevision with:originalVersionString
+ "update a revision string"
+
+ |idx leftPart rightPart vsnString newVsn|
+
+ "/ search for ,v
+ idx := originalVersionString indexOfSubCollection:'.st,v'.
+ idx == 0 ifTrue:[^ nil].
+
+ leftPart := originalVersionString copyTo:(idx - 1 + 5).
+ rightPart := (originalVersionString copyFrom:(idx + 5)) withoutSpaces.
+ idx := rightPart indexOfSeparator.
+ idx == 0 ifTrue:[^ nil].
+
+ vsnString := rightPart copyTo:idx - 1.
+ rightPart := rightPart copyFrom:idx + 1.
+
+ newRevision isNil ifTrue:[
+ (vsnString endsWith:'m') ifTrue:[
+ "/ alread a modified class
+"/ ('already modified: ' , vsnString) printNL.
+ ^ nil
+ ].
+ newVsn := vsnString , 'm'
+ ] ifFalse:[
+ newVsn := newRevision
+ ].
+
+ ^ leftPart , ' ' , newVsn , ' ' , rightPart
+
+ "Created: 7.12.1995 / 20:23:38 / cg"
+ "Modified: 16.9.1996 / 20:24:28 / cg"
+! !
+
+!CVSSourceCodeManager class methodsFor:'source code access'!
+
+checkin:containerFilename text:someText directory:packageDir module:moduleDir logMessage:logMessage force:force
+ "enter some (source) code (which is someText)
+ into the source repository. If the force argument is true, no merge is done;
+ instead, the code is checked in as given (Dangerous).
+ Return true if ok, false if not."
+
+ |tempdir cmd checkoutName logMsg revision logTmp
+ cmdOut whatHappened s idx changeLog changesAsLogged l
+ newRevision msg answer didMerge
+ mySource mergedSource modulePath time
+ editor checkInRepaired didAccept emphasizedText repairedText out
+ emSep comment|
+
+ revision := self newestRevisionInFile:containerFilename directory:packageDir module:moduleDir.
+
+ logMsg := logMessage.
+ (logMsg isNil or:[logMsg isEmpty]) ifTrue:[
+ logMsg := 'checkin from browser'.
+ ].
+
+ cmdOut := Filename newTemporary.
+ cmdOut exists ifTrue:[
+ cmdOut remove.
+ ].
+
+ "/
+ "/ in CVS, we have to checkout the file first, in order
+ "/ to get up-to-date CVS entries, and also to be able to merge in
+ "/ other users changes.
+ "/
+
+ "/
+ "/ first, create a temporary work tree
+ "/
+ tempdir := self createTempDirectory:nil forModule:nil.
+ tempdir isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: no tempDir - cannot checkin ' , containerFilename) errorPrintCR.
+ ^ false
+ ].
+
+ "/
+ "/ next, create CVS/Entries and CVS/Repository with version information of current version
+ "/
+ modulePath := moduleDir , '/' , packageDir.
+ checkoutName := modulePath , '/' , containerFilename.
+
+ revision isNil ifTrue:[
+ "/ a new file ...
+ ^ self
+ createContainerForText:someText inModule:moduleDir package:packageDir container:containerFilename
+ ].
+
+ "/
+ "/ correct our current time, so that converting it will give us UTC
+ "/
+ time := AbsoluteTime now subtractSeconds:1.
+ time := time addSeconds:(time utcOffset).
+
+ self createEntryFor:checkoutName
+ module:moduleDir
+ in:(tempdir construct:modulePath)
+ revision:revision
+ date:(self cvsTimeString:time)
+ special:''
+ overwrite:true.
+
+ "/
+ "/ copy-over our current version
+ "/
+ Stream errorSignal handle:[:ex|
+ tempdir recursiveRemove.
+ 'CVSSourceCodeManager [error]: cannot copy-over filedOut class source' errorPrintCR.
+ ^ false.
+ ] do:[
+ s := (tempdir construct:checkoutName) writeStream.
+ s nextPutAll:someText.
+ s close.
+ ].
+
+ "/
+ "/ synchronize i.e. merge in any changes
+ "/
+ self activityNotification:'merging ' , containerFilename , ' with repository version ...'.
+
+ cmd := 'update ', containerFilename, ' >', '"' , cmdOut name , '"'.
+ (self
+ executeCVSCommand:cmd
+ module:moduleDir
+ inDirectory:((tempdir construct:moduleDir) constructString:packageDir)
+ ) ifFalse:[
+ force ifFalse:[
+ 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
+ tempdir recursiveRemove.
+ cmdOut remove.
+ 'CVSSourceCodeManager [error]: cannot merge current source with repository version' errorPrintCR.
+ ^ false.
+ ].
+ ] ifTrue:[
+ "/
+ "/ check what happened - the contents of the cmdOut file may be:
+ "/ empty -> nothing changed
+ "/ M xxx -> merged-in changes from other users
+ "/ C xxx -> a conflict occured and the differences have been merged into the source
+ "/ needs special action
+ "/
+ (cmdOut exists and:[cmdOut fileSize > 0]) ifTrue:[
+ whatHappened := cmdOut contentsOfEntireFile asString.
+ ].
+ ].
+ cmdOut remove.
+
+ (whatHappened isNil or:[whatHappened isEmpty]) ifTrue:[
+ "/
+ "/ no change
+ "/
+"/ Transcript showCR:'no change in ' , containerFilename , ' (repository unchanged)'.
+ force ifFalse:[
+ self information:'nothing changed in ' , containerFilename , ' (repository unchanged)'.
+ ].
+ tempdir recursiveRemove.
+ ^ true
+ ].
+
+ Verbose == true ifTrue:[
+ ('CVSMGR: result is: ' , whatHappened) infoPrintCR.
+ ].
+
+ force ifFalse:[
+ revision isNil ifTrue:[
+ changeLog := self revisionLogOfContainer:containerFilename directory:packageDir module:moduleDir.
+ ] ifFalse:[
+ changeLog := self revisionLogOfContainer:containerFilename module:moduleDir package:packageDir fromRevision:(self revisionAfter:revision) toRevision:nil.
+ ].
+ changeLog notNil ifTrue:[
+ s := WriteStream on:String new.
+ self writeRevisionLogMessagesFrom:changeLog withHeader:false to:s.
+ changesAsLogged := s contents.
+ ] ifFalse:[
+ "/ mhmh - that should not happen
+ changesAsLogged := ''.
+ ].
+ ].
+
+ didMerge := false.
+
+ "/
+ "/ cvs above rel10 returns a multiline info ...
+ "/ we have to extract the one line which states what happened.
+ "/
+ whatHappened := whatHappened asCollectionOfLines asStringCollection.
+ whatHappened := whatHappened select:[:line |
+ (line startsWith:'RCS file') not
+ and:[(line startsWith:'retrieving') not
+ and:[(line startsWith:'Merging') not
+ and:[line size > 0]]]
+ ].
+ whatHappened := whatHappened asString.
+
+ (force or:[whatHappened startsWith:'M ']) ifTrue:[
+ "/
+ "/ merged in changes
+ "/
+ (force
+ or:[changeLog isNil
+ or:[(changeLog at:#revisions) isEmpty]]) ifTrue:[
+ "/
+ "/ pretty good - nothing has changed in the meanwhile
+ "/
+ Transcript showCR:'checking in ' , containerFilename , ' ...'
+ ] ifFalse:[
+ "/
+ "/ someone else has changed things in the meanwhile, but there is no conflict
+ "/ and version have been merged.
+ "/
+ didMerge := true.
+ changesAsLogged := changesAsLogged asCollectionOfLines.
+
+ s := WriteStream on:String new.
+ s nextPutAll:someText.
+ mySource := s contents asString.
+ mergedSource := (tempdir construct:checkoutName) readStream contents asString.
+
+ mySource = mergedSource ifTrue:[
+ msg := 'The source of ' , containerFilename , ' has been changed in the meanwhile as listed below.
+
+I have merged your version with the newest repository version,
+and found no differences between the result and your current version
+(i.e. your version seemed up-to-date).'.
+
+ self checkinTroubleDialog:'Merging versions'
+ message:msg
+ log:changesAsLogged
+ abortable:false
+ option:nil.
+ didMerge := false.
+ ] ifFalse:[
+ msg := 'The source of ' , containerFilename , ' has been changed in the meanwhile as listed below.
+
+If you continue, your new changes (based upon rev. ' , revision printString , ') will be MERGED
+into the newest revision. This will combine the other version with your changes
+into a new common revision which may be different from both.
+Although this is a nice feature, it may fail to create the expected result in certain situations.
+
+You should carefully check the result - by comparing the current version with the
+most recent version in the repository. If that does not contain an acceptable version,
+change methods as required and check in again.
+Be aware, that after that, the actual repository version is different from your current classes,
+and you should update your class from the repository.
+
+Continue ?'.
+
+ answer := self checkinTroubleDialog:'Merging versions'
+ message:msg
+ log:changesAsLogged
+ abortable:true
+ option:'Stop - see first'.
+ answer ~~ true ifTrue:[
+ answer == #option ifTrue:[
+ DiffTextView
+ openOn:mySource
+ label:'current version'
+ and:mergedSource
+ label:'merged version'.
+
+ ].
+ Transcript showCR:'checkin aborted - (no merge; repository unchanged)'.
+ tempdir recursiveRemove.
+ ^ false.
+ ].
+ ].
+
+"/ changesAsLogged := (changesAsLogged asStringCollection collect:[:line | line withTabsExpanded]) asString.
+"/ msg := 'The source of ' , containerFilename , ' has been changed in the meanwhile as follows:
+"/' , changesAsLogged , '
+"/
+"/If you continue, your new changes (based upon rev. ' , revision , ') will be MERGED
+"/into the newest revision. This will combine the other version with your changes
+"/into a new common revision which is different from both.
+"/Although convenient, it may fail to create the expected result in certain situations.
+"/
+"/You should carefully check the result - by comparing the current version with the
+"/most recent version in the repository. If that does not contain an acceptable version,
+"/change methods as required and check in again. Be aware, that the actual repository version
+"/is different from your current classes.
+"/
+"/Continue ?'.
+"/ (self confirm:msg) ifFalse:[
+"/ Transcript showCR:'checkin aborted - (no merge; repository unchanged)'.
+"/ tempdir recursiveRemove.
+"/ ^ false.
+"/ ].
+ Transcript showCR:'checking in ' , containerFilename , ' (merged other changes) ...'
+ ]
+ ] ifFalse:[
+ (whatHappened startsWith:'C ') ifTrue:[
+ "/
+ "/ conflict; someone else checked in something in the meanwhile,
+ "/ and there is a conflict between this version and the checked in version.
+ "/
+
+ changesAsLogged := changesAsLogged asCollectionOfLines.
+
+ msg := 'The source of ' , containerFilename , ' has been changed in the meanwhile as listed below.
+
+Your new changes (based upon rev. ' , revision printString , ') CONFLICT with those changes.
+
+You should fix things by comparing your class with the most recent repository version
+and change your methods avoiding conflicts. The checkin again.
+'.
+
+ answer := self checkinTroubleDialog:'Version conflict'
+ message:msg
+ log:changesAsLogged
+ abortable:false
+ option:'show conflicts'
+ option2:'resolve conflicts'.
+
+ answer == #option ifTrue:[
+ "/
+ "/ show conflicts in a 3-way DiffTextView ...
+ "/
+ Diff3TextView
+ openOnMergedText:(tempdir construct:checkoutName) readStream contents
+ label:'your version (checkin attempt)'
+ label:'original (base version)'
+ label:'newest repository version'.
+ ].
+
+ checkInRepaired := false.
+ answer == #option2 ifTrue:[
+ "/
+ "/ allow checkin of repair version
+ "/ this is error prone ...
+ "/
+ "/
+ "/ show merged version in an editor ...
+ "/ ... accept will check it in.
+ "/
+ emphasizedText := (tempdir construct:checkoutName) readStream contents.
+ emSep := (Array with:(#color->Color black)
+ with:(#backgroundColor->Color green)).
+ emphasizedText := Diff3TextView
+ emphasizeMergedDiff3Text:emphasizedText
+ emphasize1:(Array with:(#color->Color white)
+ with:(#backgroundColor->Color blue))
+ emphasize2:(Array with:(#color->Color white)
+ with:(#backgroundColor->Color red))
+ emphasizeSep:emSep.
+
+ comment :=
+'"/ ***************************************************************
+"/ This text contains your current versions code (blue)
+"/ merged with the conflicting code as found in the repository (red) which resulted
+"/ from some other checkin.
+"/ Each such conflict is surrounded by green text (like this paragraph).
+"/
+"/ Please have a look at ALL the conflicts and fix things as appropriate.
+"/ Delete the green lines as a confirmation - I will not checkin the changed text,
+"/ unless no more green parts are present. This includes this comment at the top.
+"/ ***************************************************************
+'.
+ comment := (Text string:comment emphasis:emSep) asStringCollection.
+ emphasizedText := comment , emphasizedText.
+
+ didAccept := false. checkInRepaired := true.
+ [didAccept not and:[checkInRepaired]] whileTrue:[
+ editor := RCSConflictEditTextView
+ setupWith:emphasizedText
+ title:'Resolve conflicts in ' , containerFilename , ', then accept & close to checkin'.
+
+ editor acceptAction:[:dummy |
+ repairedText := editor list.
+ didAccept := true.
+ ].
+ didAccept := false.
+ editor topView openModal.
+
+ didAccept ifFalse:[
+ (Dialog confirm:'You did not accept the new text. Edit again ?')
+ ifFalse:[
+ checkInRepaired := false.
+ ]
+ ] ifTrue:[
+ "/ check if all green-stuff (separators) have been removed
+ (repairedText findFirst:[:line | line notNil and:[line notEmpty and:[(line emphasisAt:1) = emSep]]]) ~~ 0 ifTrue:[
+ self warn:'You have to look at ALL conflicts, and remove ALL green lines as a confirmation !!'.
+ didAccept := false.
+ ]
+ ].
+
+ ].
+
+ checkInRepaired ifTrue:[
+ [
+ out := (tempdir construct:checkoutName) writeStream.
+ out nextPutAll:(repairedText asString string).
+ didAccept := true.
+ out close.
+ ] on:FileStream openErrorSignal do:[:ex|
+ self warn:'could not write file ' , (tempdir constructString:checkoutName).
+ checkInRepaired := false.
+ ].
+ ]
+ ].
+
+ checkInRepaired ifTrue:[
+ Transcript showCR:'checking in ' , containerFilename , ' (manually repaired version) ...'
+ ] ifFalse:[
+ 'CVSSourceCodeManager [warning]: cannot (for now) checkin; conflicts found' infoPrintCR.
+ Transcript showCR:'checkin of ' , containerFilename , ' aborted (conflicting changes; repository unchanged)'.
+ tempdir recursiveRemove.
+ ^ false.
+ ]
+ ] ifFalse:[
+ (whatHappened startsWith:'U ') ifTrue:[
+ "/
+ "/ nothing changed here, but the repository already contains
+ "/ a newer version.
+ "/
+ tempdir recursiveRemove.
+
+ self information:'nothing changed in your ''' , containerFilename , ''';
+but repository already contains a newer version (repository unchanged).'.
+ ^ true.
+ ] ifFalse:[
+ "/
+ "/ unexpected
+ "/
+ self warn:'unexpected message from CVS:
+' , whatHappened , '
+
+No checkin performed.'.
+ Transcript showCR:'*** cannot checkin ' , containerFilename , ' (unexpected CVS response; repository unchanged)'.
+ tempdir recursiveRemove.
+ ^ false.
+ ]
+ ]
+ ].
+
+
+ "/
+ "/ now check it in again
+ "/
+ self activityNotification:'saving ' , containerFilename , ' in repository ...'.
+
+ logMsg := logMsg replChar:$" withString:'\"'.
+
+ OperatingSystem isUNIXlike ifFalse:[
+ "/ save the log message into another tempFile ...
+ logTmp := Filename newTemporaryIn:tempdir.
+ s := logTmp writeStream.
+ s nextPutAll:logMsg.
+ s close.
+
+ cmd := 'commit -F "', logTmp baseName, '" ', checkoutName, ' >', '"' , cmdOut name , '"'.
+ ] ifTrue:[
+ "/
+ "/ CVS up to V1.9.14 prints the 'new revision' to stderr,
+ "/ CVS V1.9.16 to stdout.
+ "/
+ cmd := 'commit -m "', logMsg, '" ', checkoutName, ' >', '"' , cmdOut name , '"' , ' 2>&1'.
+ ].
+
+ (self
+ executeCVSCommand:cmd
+ module:moduleDir
+ inDirectory:tempdir name
+ ) ifFalse:[
+ 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
+
+ (cmdOut exists and:[cmdOut fileSize > 0]) ifTrue:[
+ whatHappened := cmdOut contentsOfEntireFile asString.
+ ] ifFalse:[
+ whatHappened := '<< no message >>'
+ ].
+ self warn:'The following problem was reported by cvs:
+
+' , whatHappened , '
+
+The class has NOT been checked into the repository.'.
+
+ ('CVSSourceCodeManager [error]: cvs: ' , whatHappened) errorPrintCR.
+ 'CVSSourceCodeManager [error]: cannot checkin modified class source' errorPrintCR.
+ logTmp notNil ifTrue:[logTmp remove].
+ cmdOut remove.
+ tempdir recursiveRemove.
+ ^ false.
+ ].
+ logTmp notNil ifTrue:[logTmp remove].
+ (cmdOut exists and:[cmdOut fileSize > 0]) ifTrue:[
+ whatHappened := cmdOut contentsOfEntireFile asString.
+ ] ifFalse:[
+ whatHappened := nil
+ ].
+
+ tempdir recursiveRemove.
+ cmdOut remove.
+
+ "/
+ "/ fetch the new revision nr as found in the commit commands output
+ "/
+
+ (whatHappened isNil or:[whatHappened isEmpty]) ifTrue:[
+ 'CVSSourceCodeManager [error]: unexpected empty checkin command output' errorPrintCR.
+ ] ifFalse:[
+ whatHappened := whatHappened asCollectionOfLines asStringCollection.
+ idx := whatHappened indexOfLineStartingWith:'new revision:'.
+ idx == 0 ifTrue:[
+ 'CVSSourceCodeManager [error]: unexpected checkin command output (no new-revision info)' errorPrintCR.
+ ] ifFalse:[
+ l := whatHappened at:idx.
+ newRevision := (l copyFrom:14 to:(l indexOf:$; startingAt:14)-1) withoutSpaces.
+ ]
+ ].
+ ^ true
+!
+
+checkinClass:cls fileName:classFileName directory:packageDir module:moduleDir source:sourceFileName logMessage:logMessage force:forceArg
+ "enter a classes source code (which has been already filed out into sourceFileName)
+ into the source repository. If the force argument is true, no merge is done;
+ instead, the code is checked in as given (Dangerous).
+ Return true if ok, false if not."
+
+ |tempdir cmd checkoutName logMsg revision logTmp
+ cmdOut whatHappened s entry idx changeLog changesAsLogged l
+ newRevision newString binRevision className msg answer didMerge
+ mySource mergedSource modulePath time
+ editor checkInRepaired checkInNew didAccept emphasizedText repairedText out
+ emSep comment force|
+
+ force := forceArg.
+
+ className := cls name.
+ cls isPrivate ifTrue:[
+ self error:'refuse to check in private classes.'.
+ ].
+ revision := cls revision.
+ (revision notNil
+ and:[revision endsWith:$m])
+ ifTrue:[
+ "/ this class has already been checked in with a merge,
+ "/ but not reloaded from the repository.
+ "/ must use the original revision string.
+ revision := revision copyWithoutLast:1.
+ ].
+ (binRevision := cls binaryRevision) notNil ifTrue:[
+ revision ~= binRevision ifTrue:[
+ ('CVSSourceCodeManager [info]: class ' , className , ' is based upon ' , binRevision , ' but has revision ' , (revision ? '?')) infoPrintCR
+ ]
+ ].
+
+ revision isNil ifTrue:[
+ revision := self newestRevisionOf:cls.
+ revision isNil ifTrue:[
+ force ifTrue:[
+ revision := self newestRevisionInFile:classFileName directory:packageDir module:moduleDir.
+ ] ifFalse:[
+ revision := '1.0'
+ ]
+ ]
+ ].
+
+ logMsg := logMessage.
+ (logMsg isNil or:[logMsg isEmpty]) ifTrue:[
+ logMsg := 'checkin from browser'.
+ ].
+
+ cmdOut := Filename newTemporary.
+ cmdOut exists ifTrue:[
+ cmdOut remove.
+ ].
+
+ "/
+ "/ in CVS, we have to checkout the file first, in order
+ "/ to get up-to-date CVS entries, and also to be able to merge in
+ "/ other users changes.
+ "/
+
+ "/
+ "/ first, create a temporary work tree
+ "/
+ tempdir := self createTempDirectory:nil forModule:nil.
+ tempdir isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: no tempDir - cannot checkin ' , className) errorPrintCR.
+ ^ false
+ ].
+
+ "/
+ "/ next, create CVS/Entries and CVS/Repository with version information of current version
+ "/
+ modulePath := moduleDir , '/' , packageDir.
+ checkoutName := modulePath , '/' , classFileName.
+
+ "/
+ "/ correct our current time, so that converting it will give us UTC
+ "/
+ time := AbsoluteTime now subtractSeconds:1.
+ time := time addSeconds:(time utcOffset).
+
+ self createEntryFor:checkoutName
+ module:moduleDir
+ in:(tempdir construct:modulePath)
+ revision:revision
+ date:(self cvsTimeString:time)
+ special:''
+ overwrite:true.
+
+ "/
+ "/ copy-over our current version
+ "/
+ Error handle:[:ex|
+ tempdir recursiveRemove.
+ 'CVSSourceCodeManager [error]: cannot copy-over filedOut class source' errorPrintCR.
+ ^ false.
+ ] do:[
+ sourceFileName asFilename copyTo:(tempdir construct:checkoutName).
+ ].
+
+ "/
+ "/ synchronize i.e. merge in any changes
+ "/
+ self activityNotification:'merging ' , cls name , ' with repository version ...'.
+
+ cmd := 'update ', classFileName, ' >', '"' , cmdOut name , '"'.
+ (self
+ executeCVSCommand:cmd
+ module:moduleDir
+ inDirectory:((tempdir construct:moduleDir) constructString:packageDir)
+ ) ifFalse:[
+ force ifFalse:[
+ "/ someone fiddled around with repository ?
+ (cls binaryRevision notNil
+ and:[(self checkForExistingContainerInModule:moduleDir package:packageDir container:classFileName) not ])
+ ifTrue:[
+ (Dialog confirm:('Someone seems to have removed the source container for ' , cls name , '\\Force new checkin ?') withCRs)
+ ifTrue:[
+ cls setBinaryRevision:nil.
+ ^ self checkinClass:cls fileName:classFileName directory:packageDir module:moduleDir source:sourceFileName logMessage:logMessage force:force.
+ ].
+ ].
+ ].
+ force ifFalse:[
+ 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
+ tempdir recursiveRemove.
+ cmdOut remove.
+ 'CVSSourceCodeManager [error]: cannot merge current source with repository version' errorPrintCR.
+ ^ false.
+ ].
+ ] ifTrue:[
+ "/
+ "/ check what happened - the contents of the cmdOut file may be:
+ "/ empty -> nothing changed
+ "/ M xxx -> merged-in changes from other users
+ "/ C xxx -> a conflict occured and the differences have been merged into the source
+ "/ needs special action
+ "/
+ (cmdOut exists and:[cmdOut fileSize > 0]) ifTrue:[
+ whatHappened := cmdOut contentsOfEntireFile asString.
+ ].
+ ].
+ cmdOut remove.
+
+ (whatHappened isNil or:[whatHappened isEmpty]) ifTrue:[
+ "/
+ "/ no change
+ "/
+"/ Transcript showCR:'no change in ' , className , ' (repository unchanged)'.
+ tempdir recursiveRemove.
+
+ force ifFalse:[
+"/ (ChangeSet current includesChangeForClass:cls) ifTrue:[
+"/ (self confirm:('Nothing changed in %1 (repository unchanged).\\Remove entries from changeSet ?' bindWith:className) withCRs) ifTrue:[
+"/ ChangeSet current condenseChangesForClass:cls.
+"/ ].
+"/ ] ifFalse:[
+ self information:('Nothing changed in %1 (repository unchanged)' bindWith:className).
+"/ ].
+ self postCheckInClass:cls.
+ ] ifTrue:[
+ changeLog := self revisionLogOfContainer:classFileName directory:packageDir module:moduleDir.
+ (changeLog isNil or:[(changeLog at:#revisions) size ~~ 1]) ifTrue:[
+ 'CVSSourceCodeManager [error]: failed to update revisionString (no log)' errorPrintCR.
+ cls updateVersionMethodFor:'$' , 'Header' , '$'. "/ concatenated to avoid RCS expansion
+ ] ifFalse:[
+ entry := (changeLog at:#revisions) first.
+ newString := self revisionStringFromLog:changeLog entry:entry forClass:cls.
+ cls updateVersionMethodFor:newString.
+ cls revision ~= newRevision ifTrue:[
+ 'CVSSourceCodeManager [error]: failed to update revisionString' errorPrintCR
+ ]
+ ]
+ ].
+
+ ^ true
+ ].
+
+ Verbose == true ifTrue:[
+ ('CVSMGR: result is: ' , whatHappened) infoPrintCR.
+ ].
+
+ force ifFalse:[
+ revision isNil ifTrue:[
+ changeLog := self revisionLogOf:cls.
+ ] ifFalse:[
+ changeLog := self revisionLogOf:cls fromRevision:(self revisionAfter:revision) toRevision:nil.
+ ].
+ changeLog notNil ifTrue:[
+ s := WriteStream on:String new.
+ self writeRevisionLogMessagesFrom:changeLog withHeader:false to:s.
+ changesAsLogged := s contents.
+ ] ifFalse:[
+ "/ mhmh - that should not happen
+ changesAsLogged := ''.
+ ].
+ ].
+
+ didMerge := false.
+ checkInRepaired := checkInNew := false.
+
+ "/
+ "/ cvs above rel10 returns a multiline info ...
+ "/ we have to extract the one line which states what happened.
+ "/
+ whatHappened := whatHappened asCollectionOfLines asStringCollection.
+ whatHappened := whatHappened select:[:line |
+ (line startsWith:'RCS file') not
+ and:[(line startsWith:'retrieving') not
+ and:[(line startsWith:'Merging') not
+ and:[line size > 0]]]
+ ].
+ whatHappened := whatHappened asString.
+
+ (force or:[whatHappened startsWith:'M ']) ifTrue:[
+ "/
+ "/ merged in changes
+ "/
+ (force
+ or:[changeLog isNil
+ or:[(changeLog at:#revisions) isEmpty]]) ifTrue:[
+ "/
+ "/ pretty good - nothing has changed in the meanwhile
+ "/
+ Transcript showCR:'checking in ' , className , ' ...'
+ ] ifFalse:[
+ "/
+ "/ someone else has changed things in the meanwhile, but there is no conflict
+ "/ and version have been merged.
+ "/
+ didMerge := true.
+ changesAsLogged := changesAsLogged asCollectionOfLines.
+
+ s := WriteStream on:String new.
+ cls fileOutOn:s withTimeStamp:false.
+ mySource := s contents asString.
+ mergedSource := (tempdir construct:checkoutName) readStream contents asString.
+
+ mySource = mergedSource ifTrue:[
+ msg := 'The source of ' , className , ' has been changed in the meanwhile as listed below.
+
+I have merged your version with the newest repository version,
+and found no differences between the result and your current version
+(i.e. your version seemed up-to-date).'.
+
+ self checkinTroubleDialog:'Merging versions'
+ message:msg
+ log:changesAsLogged
+ abortable:false
+ option:nil.
+ didMerge := false.
+ ] ifFalse:[
+ msg := 'The source of ' , className , ' has been changed in the meanwhile as listed below.
+
+If you continue, your new changes (based upon rev. ' , revision printString , ') will be MERGED
+into the newest revision. This will combine the other version with your changes
+into a new common revision which may be different from both.
+Although this is a nice feature, it may fail to create the expected result in certain situations.
+
+You should carefully check the result - by comparing the current version with the
+most recent version in the repository. If that does not contain an acceptable version,
+change methods as required and check in again.
+Be aware, that after that, the actual repository version is different from your current classes,
+and you should update your class from the repository.
+
+Continue ?'.
+
+ answer := self checkinTroubleDialog:'Merging versions'
+ message:msg
+ log:changesAsLogged
+ abortable:true
+ option:'Stop - see first'
+ option2:'Do NOT Merge - Force my Code'.
+
+ answer == #option2 ifTrue:[
+ (Dialog confirm:'Are you certain that you want to suppress a merge and force your code to be checked in ?')
+ ifTrue:[
+ s := (tempdir construct:checkoutName) writeStream.
+ cls fileOutOn:s withTimeStamp:false.
+ s close.
+ answer := true.
+ ]
+ ].
+
+ answer ~~ true ifTrue:[
+ answer == #option ifTrue:[
+ DiffTextView
+ openOn:mySource
+ label:'current version'
+ and:mergedSource
+ label:'merged version'.
+
+ ].
+ Transcript showCR:'checkin aborted - (no merge; repository unchanged)'.
+ tempdir recursiveRemove.
+ ^ false.
+ ].
+ ].
+
+"/ changesAsLogged := (changesAsLogged asStringCollection collect:[:line | line withTabsExpanded]) asString.
+"/ msg := 'The source of ' , className , ' has been changed in the meanwhile as follows:
+"/' , changesAsLogged , '
+"/
+"/If you continue, your new changes (based upon rev. ' , revision , ') will be MERGED
+"/into the newest revision. This will combine the other version with your changes
+"/into a new common revision which is different from both.
+"/Although convenient, it may fail to create the expected result in certain situations.
+"/
+"/You should carefully check the result - by comparing the current version with the
+"/most recent version in the repository. If that does not contain an acceptable version,
+"/change methods as required and check in again. Be aware, that the actual repository version
+"/is different from your current classes.
+"/
+"/Continue ?'.
+"/ (self confirm:msg) ifFalse:[
+"/ Transcript showCR:'checkin aborted - (no merge; repository unchanged)'.
+"/ tempdir recursiveRemove.
+"/ ^ false.
+"/ ].
+ Transcript showCR:'checking in ' , className , ' (merged other changes) ...'
+ ]
+ ] ifFalse:[
+ (whatHappened startsWith:'C ') ifTrue:[
+ "/
+ "/ conflict; someone else checked in something in the meanwhile,
+ "/ and there is a conflict between this version and the checked in version.
+ "/
+
+ changesAsLogged := changesAsLogged asCollectionOfLines.
+
+ msg := 'The source of ' , className , ' has been changed in the meanwhile as listed below.
+
+Your new changes (based upon rev. ' , revision printString , ') CONFLICT with those changes.
+
+You should fix things by comparing your class with the most recent repository version
+and change your methods avoiding conflicts. The checkin again.
+'.
+
+ answer := self checkinTroubleDialog:'Version conflict'
+ message:msg
+ log:changesAsLogged
+ abortable:false
+ option:'Show conflicts'
+ option2:'Resolve conflicts'
+ option3:'Do NOT Merge - Force my Code'.
+
+ answer == #option ifTrue:[
+ "/
+ "/ show conflicts in a 3-way DiffTextView ...
+ "/
+ Diff3TextView
+ openOnMergedText:(tempdir construct:checkoutName) readStream contents
+ label:'your version (checkin attempt)'
+ label:'original (base version)'
+ label:'newest repository version'.
+ ].
+
+ answer == #option2 ifTrue:[
+ "/
+ "/ allow checkin of repair version
+ "/ this is error prone ...
+ "/
+ "/
+ "/ show merged version in an editor ...
+ "/ ... accept will check it in.
+ "/
+ emphasizedText := (tempdir construct:checkoutName) readStream contents.
+ emSep := (Array with:(#color->Color black)
+ with:(#backgroundColor->Color green)).
+ emphasizedText := Diff3TextView
+ emphasizeMergedDiff3Text:emphasizedText
+ emphasize1:(Array with:(#color->Color white)
+ with:(#backgroundColor->Color blue))
+ emphasize2:(Array with:(#color->Color white)
+ with:(#backgroundColor->Color red))
+ emphasizeSep:emSep.
+
+ comment :=
+'"/ ***************************************************************
+"/ This text contains your current versions code (blue)
+"/ merged with the conflicting code as found in the repository (red) which resulted
+"/ from some other checkin.
+"/ Each such conflict is surrounded by green text (like this paragraph).
+"/
+"/ Please have a look at ALL the conflicts and fix things as appropriate.
+"/ Delete the green lines as a confirmation - I will not checkin the changed text,
+"/ unless no more green parts are present. This includes this comment at the top.
+"/ ***************************************************************
+'.
+ comment := (Text string:comment emphasis:emSep) asStringCollection.
+ emphasizedText := comment , emphasizedText.
+
+ didAccept := false. checkInRepaired := true.
+ [didAccept not and:[checkInRepaired]] whileTrue:[
+ editor := RCSConflictEditTextView
+ setupWith:emphasizedText
+ title:'Resolve conflicts in ' , className , ', then accept & close to checkin'.
+
+ editor acceptAction:[:dummy |
+ repairedText := editor list.
+ didAccept := true.
+ ].
+ didAccept := false.
+ editor topView openModal.
+
+ didAccept ifFalse:[
+ (Dialog confirm:'You did not accept the new text. Edit again ?')
+ ifFalse:[
+ checkInRepaired := false.
+ ]
+ ] ifTrue:[
+ "/ check if all green-stuff (separators) have been removed
+ (repairedText findFirst:[:line | line notNil and:[line notEmpty and:[(line emphasisAt:1) = emSep]]]) ~~ 0 ifTrue:[
+ self warn:'You have to look at ALL conflicts, and remove ALL green lines as a confirmation !!'.
+ didAccept := false.
+ ]
+ ].
+
+ ].
+
+ checkInRepaired ifTrue:[
+ [
+ out := (tempdir construct:checkoutName) writeStream.
+ out nextPutAll:(repairedText asString string).
+ didAccept := true.
+ out close.
+ ] on:FileStream openErrorSignal do:[:ex|
+ self warn:'could not write file ' , (tempdir constructString:checkoutName).
+ checkInRepaired := false.
+ ].
+ ]
+ ].
+
+ answer == #option3 ifTrue:[
+ "/
+ "/ force checkin of new version
+ "/
+ "/
+ "/ show merged version in an editor ...
+ "/ ... accept will check it in.
+ "/
+ [
+ out := (tempdir construct:checkoutName) writeStream.
+ out nextPutAll:(mySource asString string).
+ didAccept := true.
+ out close.
+ checkInNew := checkInRepaired := true.
+ ] on:FileStream openErrorSignal do:[:ex|
+ self warn:'could not write file ' , (tempdir constructString:checkoutName).
+ ].
+ ].
+
+ checkInRepaired ifTrue:[
+ checkInNew ifTrue:[
+ Transcript showCR:'checking in ' , className , ' (force new version)...'
+ ] ifFalse:[
+ Transcript showCR:'checking in ' , className , ' (manually repaired version)...'
+ ].
+ ] ifFalse:[
+ 'CVSSourceCodeManager [warning]: cannot (for now) checkin; conflicts found' infoPrintCR.
+ Transcript showCR:'checkin of ' , className , ' aborted (conflicting changes; repository unchanged)'.
+ tempdir recursiveRemove.
+ ^ false.
+ ]
+ ] ifFalse:[
+ ((whatHappened startsWith:'U ')
+ or:[ (whatHappened startsWith:'P ') ]) ifTrue:[
+ "/
+ "/ nothing changed here, but the repository already contains
+ "/ a newer version.
+ "/
+ tempdir recursiveRemove.
+
+ self information:'nothing changed in your ''' , className , ''';
+but repository already contains a newer version (repository unchanged).'.
+ ^ true.
+ ] ifFalse:[
+ "/
+ "/ unexpected
+ "/
+ self warn:'unexpected message from CVS:
+' , whatHappened , '
+
+No checkin performed.'.
+ Transcript showCR:'*** cannot checkin ' , className , ' (unexpected CVS response; repository unchanged)'.
+ tempdir recursiveRemove.
+ ^ false.
+ ]
+ ]
+ ].
+
+
+ "/
+ "/ now check it in again
+ "/
+ self activityNotification:'saving ' , cls name , ' in repository ...'.
+
+ logMsg := logMsg replChar:$" withString:'\"'.
+
+ OperatingSystem isUNIXlike ifFalse:[
+ "/ save the log message into another tempFile ...
+ logTmp := Filename newTemporaryIn:tempdir.
+ s := logTmp writeStream.
+ s nextPutAll:logMsg.
+ s close.
+
+ cmd := 'commit -F "', logTmp baseName, '" ', checkoutName, ' >', '"' , cmdOut name , '"'.
+ ] ifTrue:[
+ "/
+ "/ CVS up to V1.9.14 prints the 'new revision' to stderr,
+ "/ CVS V1.9.16 to stdout.
+ "/
+ cmd := 'commit -m "', logMsg, '" ', checkoutName, ' >', '"', cmdOut name, '"' , ' 2>&1'.
+ ].
+ (self
+ executeCVSCommand:cmd
+ module:moduleDir
+ inDirectory:tempdir name
+ ) ifFalse:[
+ 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
+
+ (cmdOut exists and:[cmdOut fileSize > 0]) ifTrue:[
+ whatHappened := cmdOut contentsOfEntireFile asString.
+ ] ifFalse:[
+ whatHappened := '<< no message >>'
+ ].
+ self warn:'The following problem was reported by cvs:
+
+' , whatHappened , '
+
+The class has NOT been checked into the repository.'.
+
+ 'CVSSourceCodeManager [error]: cannot checkin modified class source' errorPrintCR.
+ logTmp notNil ifTrue:[logTmp remove].
+ cmdOut remove.
+ tempdir recursiveRemove.
+ ^ false.
+ ].
+ logTmp notNil ifTrue:[logTmp remove].
+ (cmdOut exists and:[cmdOut fileSize > 0]) ifTrue:[
+ whatHappened := cmdOut contentsOfEntireFile asString.
+ ] ifFalse:[
+ whatHappened := nil
+ ].
+
+ tempdir recursiveRemove.
+ cmdOut remove.
+
+ "/
+ "/ fetch the new revision nr as found in the commit commands output
+ "/
+
+ (whatHappened isNil or:[whatHappened isEmpty]) ifTrue:[
+ 'CVSSourceCodeManager [error]: unexpected empty checkin command output' errorPrintCR.
+ ] ifFalse:[
+ whatHappened := whatHappened asCollectionOfLines asStringCollection.
+ idx := whatHappened indexOfLineStartingWith:'new revision:'.
+ idx == 0 ifTrue:[
+ 'CVSSourceCodeManager [error]: unexpected checkin command output (no new-revision info)' errorPrintCR.
+ ] ifFalse:[
+ l := whatHappened at:idx.
+ newRevision := (l copyFrom:14 to:(l indexOf:$; startingAt:14)-1) withoutSpaces.
+ ]
+ ].
+
+ "/
+ "/ if there was no merge (i.e. the current version has been checked in unchanged):
+ "/ patch the classes revisionInfo (but keep binaryRevision unchanged) to the new revision
+ "/ this makes everyone here believe, that the incore version of the class is based upon
+ "/ the newly checked in version.
+ "/ (however, the binaryRevision must remain as it is - we will need it to fetch the sourceCode
+ "/ correctly for all unchanged methodss)
+ "/
+ "/ if there was a merge (i.e. the repository now contains a merge of the current and some
+ "/ other version):
+ "/ patch the classes revisionInfo (again, keep the binaryRevision) to the old revision
+ "/ and add a 'm' (for merged).
+ "/ If we later checkin again, the new checkin will be again based on the current revision
+ "/
+ newRevision notNil ifTrue:[
+ didMerge ifFalse:[
+ self activityNotification:'fetch new revision number of ', cls name.
+
+ changeLog := self revisionLogOf:cls fromRevision:newRevision toRevision:newRevision.
+ (changeLog isNil or:[(changeLog at:#revisions) size ~~ 1]) ifTrue:[
+ force ifTrue:[
+ changeLog := self revisionLogOfContainer:classFileName directory:packageDir module:moduleDir.
+ ].
+ ].
+ (changeLog isNil or:[(changeLog at:#revisions) size ~~ 1]) ifTrue:[
+ 'CVSSourceCodeManager [error]: failed to update revisionString (no log)' errorPrintCR.
+ cls updateVersionMethodFor:'$' , 'Header' , '$'. "/ concatenated to avoid RCS expansion
+ ] ifFalse:[
+ entry := (changeLog at:#revisions) first.
+ newString := self revisionStringFromLog:changeLog entry:entry forClass:cls.
+ cls updateVersionMethodFor:newString.
+ cls revision ~= newRevision ifTrue:[
+ 'CVSSourceCodeManager [error]: failed to update revisionString' errorPrintCR
+ ]
+ ]
+ ] ifTrue:[
+ newString := self updatedRevisionStringOf:cls forRevision:nil with:cls revisionString.
+ cls updateVersionMethodFor:newString.
+ ].
+ ].
+
+ Class addChangeRecordForClassCheckIn:cls.
+ self postCheckInClass:cls.
+
+ (checkInRepaired and:[checkInNew not]) ifTrue:[
+ self information:'Now the repository contains a merge between your and the other changes.
+However, the class in your image does NOT contain the other changes.
+This will lead to more conflict-resolving whenever you check this class in again later,
+unless you load the newest (merged) version of the class from the repository.
+
+I recommend doing this as soon as possible via your browsers checkout function.'
+ ].
+ ^ true
+
+ "
+ SourceCodeManager checkinClass:Array logMessage:'testing only'
+ "
+
+ "Created: / 11.9.1996 / 16:16:11 / cg"
+ "Modified: / 26.2.1998 / 17:34:16 / stefan"
+ "Modified: / 5.11.2001 / 14:35:38 / 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."
+
+ |cvsRoot packageDir tempdir cmdOut cmd dirName|
+
+ cvsRoot := self getCVSROOTForModule:aModule.
+ cvsRoot isNil ifTrue:[^ false ].
+
+ aPackage notNil ifTrue:[
+ dirName := aModule , '/' , aPackage.
+ ] ifFalse:[
+ dirName := aModule.
+ ].
+
+ self activityNotification:'checking out everything in ' , dirName , ' ...'.
+
+ tempdir := self createTempDirectory:nil forModule:nil.
+ tempdir isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: no tempDir - cannot checkout') errorPrintCR.
+ ^ false
+ ].
+
+ cmd := '-l checkout ', dirName.
+ OperatingSystem isUNIXlike ifTrue:[
+ "/ can redirect output
+ cmdOut := Filename newTemporary.
+ cmdOut exists ifTrue:[
+ cmdOut remove.
+ ].
+ cmd := cmd , ' > ', '"' , cmdOut name, '"' .
+ ].
+
+ (self
+ executeCVSCommand:cmd
+ module:aModule
+ inDirectory:tempdir name
+ ) ifFalse:[
+ 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
+ cmdOut notNil ifTrue:[cmdOut remove].
+ tempdir recursiveRemove.
+ ^ false
+ ].
+
+ cmdOut notNil ifTrue:[
+"/ listOfFiles := cmdOut contents.
+ cmdOut remove
+ ].
+
+ packageDir := (tempdir construct:dirName).
+ (packageDir isDirectory) ifFalse:[
+ 'CVSSourceCodeManager [error]: checkout failed (no dir)' errorPrintCR.
+ tempdir recursiveRemove.
+ ^ false
+ ].
+
+ "/ now, invoke the block ...
+ [
+ aBlock value:packageDir
+ ] ensure:[
+ tempdir recursiveRemove.
+ ].
+
+ ^ true
+
+ "Modified: / 28.4.1999 / 12:21:10 / cg"
+!
+
+streamForClass:cls fileName:fileName revision:revision directory:packageDir module:moduleDir cache:cacheIt
+ "extract a source file and return an open readStream on it,
+ or nil if the extract failed. If revision is nil or (#newest), take
+ the latest; otherwise, a specific revisions source is extracted.
+ The cls argument is currently ignored, but may be used in future versions,
+ to validate the correct container against the class.
+ To check out a file (i.e. not a classes file), leave it nil."
+
+ |dir cachedSourceFilename cachedFile cmd fullName revisionArg stream
+ checkoutName checkoutNameLocal fullTempName fullCachedName tempdir cmdOut
+ classFileName cvsRoot tempFile revMsg|
+
+ (DisabledModules notNil and:[DisabledModules includes:moduleDir]) ifTrue:[
+ Transcript showCR:'cvs access for module ' , moduleDir , ' has been disabled (due to previous failure)'.
+ Transcript showCR:'reenable using the launchers source&debugger dialog'.
+
+ ^ nil
+ ].
+
+ cvsRoot := self getCVSROOTForModule:moduleDir.
+ cvsRoot isNil ifTrue:[^ nil].
+
+ "/ if not already existing, create a cache directory
+ "/ where we deposit sources.
+ "/ this is used as a cache for further requests, since
+ "/ accessing the repository may be slow.
+ "/ (if cvs uses a remote connection via ppp, for example)
+ "/
+
+ revision ~~ #newest ifTrue:[
+ (dir := self sourceCacheDirectory) isNil ifTrue:[
+ 'CVSSourceCodeManager [warning]: no source cache directory' errorPrintCR.
+ ]
+ ].
+
+ classFileName := fileName.
+ (classFileName endsWith:',v') ifTrue:[
+ classFileName := classFileName copyWithoutLast:2.
+ ].
+ (classFileName endsWith:'.st') ifTrue:[
+ cls notNil ifTrue:[
+ classFileName := classFileName copyWithoutLast:3.
+ ]
+ ].
+ fullName := moduleDir , '/' , packageDir , '/' , classFileName.
+ cls notNil ifTrue:[
+ fullName := fullName , '.st'.
+ ].
+
+ (revision isNil or:[revision == #newest]) ifTrue:[
+ cachedSourceFilename := classFileName.
+ ] ifFalse:[
+ cachedSourceFilename := classFileName , '_' , revision.
+ ].
+
+ dir notNil ifTrue:[
+ cachedFile := dir construct:cachedSourceFilename.
+ cachedFile exists ifTrue:[
+"/ cachedFile fileSize < 10 ifTrue:[
+"/ ('CVSSourceCodeManager [warning]: existing: ', cachedFile name , ' seems corrupted.') errorPrintCR.
+"/ cachedFile remove
+"/ ] ifFalse:[
+"/ ('CVSSourceCodeManager [info]: found existing: ', cachedFile name) infoPrintCR.
+ ^ cachedFile readStream
+"/ ]
+ ].
+ ].
+
+ "/
+ "/ first, create a temporary work tree
+ "/ Do not make module and package directories, their existence cause cvs checkout to fail in server mode
+ "/
+ tempdir := self createTempDirectory:nil forModule:nil.
+ tempdir isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: no tempDir - cannot checkout ' , classFileName) errorPrintCR.
+ ^ nil
+ ].
+
+"/ tempdir := Filename newTemporaryIn:nil.
+"/ tempdir exists ifTrue:[
+"/ tempdir recursiveRemove.
+"/ ].
+"/ tempdir makeDirectory.
+"/ dir := tempdir construct:moduleDir.
+"/ dir makeDirectory.
+"/ dir := dir construct:packageDir.
+"/ dir recursiveMakeDirectory.
+"/ dir exists ifFalse:[
+"/ tempdir recursiveRemove.
+"/ 'CVSMGR: cannot create temporary directory' infoPrintCR.
+"/ ^ nil.
+"/ ].
+
+ "/
+ "/ check it out there
+ "/
+ checkoutName := fullName.
+
+ checkoutNameLocal := (moduleDir asFilename construct:packageDir) constructString:(fullName asFilename baseName).
+
+ (revision isNil or:[revision == #newest]) ifTrue:[
+ cachedSourceFilename := classFileName.
+ revisionArg := ''.
+ revMsg := ''.
+ ] ifFalse:[
+ cachedSourceFilename := classFileName , '_' , revision.
+ revisionArg := ' -r ' , revision.
+ revMsg := ' (' , revision , ')'.
+ ].
+
+ self activityNotification:'checking out source ' , checkoutName , revMsg.
+ OperatingSystem isUNIXlike ifTrue:[
+ "/ can redirect output
+ cmdOut := Filename newTemporary.
+ cmdOut exists ifTrue:[
+ cmdOut remove.
+ ].
+ cmd := '-l checkout' , revisionArg , ' ', checkoutName , ' > ' , '"' , cmdOut name, '"' .
+ ] ifFalse:[
+ cmd := '-l checkout' , revisionArg , ' ', checkoutName.
+ ].
+
+ (self
+ executeCVSCommand:cmd
+ module:moduleDir
+ inDirectory:tempdir name
+ ) ifFalse:[
+ 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
+ cmdOut notNil ifTrue:[cmdOut remove].
+ tempdir recursiveRemove.
+ ('CVSSourceCodeManager [error]: cannot checkout ' , checkoutName) errorPrintCR.
+ "/ see if there is CVS access at all ...
+ (self checkForExistingModule:moduleDir) ifFalse:[
+ "/ disable
+ DisabledModules isNil ifTrue:[
+ DisabledModules := Set new.
+ ].
+ DisabledModules add:moduleDir.
+ ('CVSSourceCodeManager [warning]: disabled repository access for module ' , moduleDir) errorPrintCR.
+ ].
+ ^ nil.
+ ].
+
+ cmdOut notNil ifTrue:[cmdOut remove].
+ fullTempName := tempdir construct:checkoutNameLocal.
+ fullCachedName := CacheDirectoryName asFilename constructString:cachedSourceFilename.
+
+ fullTempName exists ifFalse:[
+ ('CVSSourceCodeManager [error]: failed to checkout ', fullTempName pathName, ' (file does not exist after cvs co)') errorPrintCR.
+ tempdir recursiveRemove.
+ ^ nil
+ ].
+
+ (cacheIt
+ and:[cachedFile notNil
+ and:[fullTempName exists]])
+ ifTrue:[
+ (OperatingSystem errorSignal catch:[
+ fullTempName moveTo:fullCachedName
+ ]) ifTrue:[
+ ('CVSSourceCodeManager [error]: failed to rename ', fullTempName pathName, ' to ', cachedSourceFilename) errorPrintCR.
+ tempdir recursiveRemove.
+ ^ nil
+ ].
+ fullCachedName asFilename exists ifTrue:[
+ stream := fullCachedName asFilename readStream.
+ ].
+ ] ifFalse:[
+ OperatingSystem isUNIXlike ifFalse:[
+ "/ cannot remove files which are still open ...
+ "/ sigh - need a delete-on-close flag in FileStream.
+ "/
+ tempFile := Filename newTemporary.
+ fullTempName copyTo:tempFile.
+ stream := tempFile readStream.
+ stream notNil ifTrue:[
+ stream removeOnClose:true.
+ ].
+ ] ifTrue:[
+ stream := fullTempName readStream.
+ ]
+ ].
+
+ self releaseAndRemove:tempdir module:moduleDir outputTo:nil.
+ ^ stream
+
+ "Created: / 4.11.1995 / 19:46:20 / cg"
+ "Modified: / 20.8.1997 / 16:37:11 / stefan"
+ "Modified: / 23.8.2001 / 12:28:59 / cg"
+! !
+
+!CVSSourceCodeManager class methodsFor:'source code administration'!
+
+checkForExistingContainerInModule:moduleDir package:packageDir container:fileName
+ "check for a container to exist"
+
+ |fullName ret cvsRoot cmd tempDir|
+
+ cvsRoot := self getCVSROOTForModule:moduleDir.
+
+ fullName := moduleDir , '/' , packageDir , '/' , fileName.
+
+ RemoteCVS ifFalse:[
+ cvsRoot asFilename exists ifTrue:[
+ "/
+ "/ with local CVS - simply check if that file exists
+ "/
+ (fullName endsWith:',v') ifFalse:[
+ fullName := fullName , ',v'.
+ ].
+ ^ (cvsRoot , '/' , fullName) asFilename exists.
+ ].
+ ].
+
+ tempDir := self createTempDirectory:nil forModule:nil.
+
+ "With remote CVS, do a no-op rtag command, which doesn't
+ need a working directory, but reports missing files"
+
+ (fullName endsWith:',v') ifTrue:[
+ fullName := fullName copyWithoutLast:2.
+ ].
+
+ cmd := '-n rtag -l -F dummy '.
+ [
+ ret := self
+ executeCVSCommand:cmd , fullName
+ module:moduleDir
+ "/ cg; cannot do it in current dir, in case it contains a CVS subDirectory,
+ "/ with a different CVSRoot in its CVS/Root file ...
+ "/ cvs would complain then.
+ inDirectory:(tempDir pathName)
+ log:false.
+ ] ensure:[
+ tempDir recursiveRemove.
+ ].
+ ^ ret
+
+ "
+ CVSSourceCodeManager
+ checkForExistingContainerInModule:'stx'
+ package:'libbasic'
+ container:'Integer.st'
+
+ CVSSourceCodeManager
+ checkForExistingContainerInModule:'stx'
+ package:'libtool'
+ container:'AboutBox.st'
+
+ CVSSourceCodeManager
+ checkForExistingContainerInModule:'stx'
+ package:'libtool'
+ container:'AboutBox.st,v'
+
+ CVSSourceCodeManager
+ checkForExistingContainerInModule:'stx'
+ package:'libtool'
+ container:'FooBar.st'
+
+ CVSSourceCodeManager
+ checkForExistingContainerInModule:'DPU'
+ package:'test'
+ container:'marks'
+ "
+
+ "Created: / 9.12.1995 / 19:13:37 / cg"
+ "Modified: / 1.3.1999 / 19:32:55 / cg"
+ "Modified: / 23.7.1999 / 17:36:58 / stefan"
+!
+
+checkForExistingModule:moduleDir
+ "check for a module to exist"
+
+ |ret cvsRoot cmd tempDir|
+
+ self activityNotification:'checking for existing module ' , moduleDir.
+
+ cvsRoot := self getCVSROOTForModule:moduleDir.
+ cvsRoot isNil ifTrue:[^ false].
+
+ RemoteCVS ifFalse:[
+ cvsRoot asFilename exists ifTrue:[
+ "/
+ "/ with local CVS - simply check if that directory exists
+ "/
+ ^ (cvsRoot , '/' , moduleDir) asFilename isDirectory.
+ ]
+ ].
+
+ tempDir := self createTempDirectory:nil forModule:nil.
+
+ "With remote CVS, do a no-op rtag command, which doesn't
+ need a working directory, but reports missing files"
+
+ cmd := '-n rtag -l dummy '.
+ [
+ ret := self
+ executeCVSCommand:cmd , moduleDir
+ module:moduleDir
+ "/ cg; cannot do it in current dir, in case it contains a CVS subDirectory,
+ "/ with a different CVSRoot in its CVS/Root file ...
+ "/ cvs would complain then.
+ inDirectory:(tempDir pathName)
+ log:false.
+ ] ensure:[
+ tempDir recursiveRemove.
+ ].
+ ^ ret
+
+ "
+ CVSSourceCodeManager checkForExistingModule:'stx'
+ CVSSourceCodeManager checkForExistingModule:'DPU'
+ CVSSourceCodeManager checkForExistingModule:'cg'
+ CVSSourceCodeManager checkForExistingModule:'aeg'
+ CVSSourceCodeManager checkForExistingModule:'foo'
+ "
+
+ "Created: / 9.12.1995 / 19:13:37 / cg"
+ "Modified: / 1.3.1999 / 19:32:59 / cg"
+ "Modified: / 23.7.1999 / 17:38:59 / stefan"
+!
+
+checkForExistingModule:moduleDir package:packageDir
+ "check for a package to exist"
+
+ |ret cvsRoot cmd tempDir fullName |
+
+ self activityNotification:'checking for existing package ' , packageDir.
+
+ fullName := moduleDir , '/' , packageDir.
+ cvsRoot := self getCVSROOTForModule:moduleDir.
+
+ RemoteCVS ifFalse:[
+ cvsRoot asFilename exists ifTrue:[
+ "/
+ "/ with local CVS - simply check if that directory exists
+ "/
+ ^ (cvsRoot , '/' , fullName) asFilename isDirectory.
+ ].
+ ].
+
+ tempDir := self createTempDirectory:nil forModule:nil.
+
+ "With remote CVS, do a no-op rtag command, which doesn't
+ need a working directory, but reports missing files"
+
+ cmd := '-n rtag -l -F dummy '.
+ [
+ ret := self
+ executeCVSCommand:cmd, fullName
+ module:moduleDir
+ "/ cg; cannot do it in current dir, in case it contains a CVS subDirectory,
+ "/ with a different CVSRoot in its CVS/Root file ...
+ "/ cvs would complain then.
+ inDirectory:(tempDir pathName)
+ log:false.
+
+ ] ensure:[
+ tempDir recursiveRemove.
+ ].
+ ^ ret
+
+ "
+ CVSSourceCodeManager checkForExistingModule:'stx' package:'libbasic'
+ CVSSourceCodeManager checkForExistingModule:'aeg' package:'libProgram'
+ CVSSourceCodeManager checkForExistingModule:'foo' package:'libbasic'
+ CVSSourceCodeManager checkForExistingModule:'foo' package:'bar'
+ CVSSourceCodeManager checkForExistingModule:'cg' package:'private'
+ "
+
+ "Created: / 9.12.1995 / 19:13:37 / cg"
+ "Modified: / 1.3.1999 / 19:33:04 / cg"
+ "Modified: / 23.7.1999 / 17:39:21 / stefan"
+!
+
+createContainerFor:aClass inModule:moduleDir package:packageDir container:fileName
+ "create a container - this does an initial checkin
+ (i.e. cvs add & cvs commit)"
+
+ |fullName tempdir checkoutName cmdOut cmd tempFile idx aStream whatHappened l newRevision
+ changeLog entry newString startIdx endIdx checkInDir logTmp s|
+
+
+ cmdOut := Filename newTemporary.
+ cmdOut exists ifTrue:[
+ cmdOut remove.
+ ].
+
+ fullName := moduleDir , '/' , packageDir , '/' , fileName.
+ checkoutName := moduleDir , '/' , packageDir.
+
+ "/
+ "/ first, check out everything there - this creates the CVS helpfiles
+ "/ required later.
+ "/
+
+ self activityNotification:'checking for directory ' , checkoutName.
+ tempdir := self createLocalDirectory:packageDir inModule:moduleDir.
+ tempdir isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: cannot checkout ' , checkoutName) errorPrintCR.
+ ^ false.
+ ].
+
+ "/
+ "/ create the source there
+ "/
+ tempFile := (tempdir construct:checkoutName) construct:fileName.
+ [
+ aStream := tempFile writeStream.
+ ] on:FileStream openErrorSignal do:[:ex|
+ ('CVSSourceCodeManager [error]: temporary fileout failed -> ', tempFile name) errorPrintCR.
+ tempdir recursiveRemove.
+ ^ false
+ ].
+
+ Class fileOutErrorSignal handle:[:ex |
+ 'CVSSourceCodeManager [error]: fileout failed' errorPrintCR.
+ aStream close.
+ tempdir recursiveRemove.
+ ^ false
+ ] do:[
+ aClass fileOutOn:aStream withTimeStamp:false.
+ ].
+ aStream close.
+
+ tempFile exists ifFalse:[
+ 'CVSSourceCodeManager [error]: temporary fileout failed' errorPrintCR.
+ tempdir recursiveRemove.
+ ^ false
+ ].
+
+ "/
+ "/ and add it to the repository
+ "/
+ self activityNotification:'adding ' , fileName.
+
+ OperatingSystem isUNIXlike ifTrue:[
+ checkInDir := tempdir constructString:checkoutName.
+ ] ifFalse:[
+ OperatingSystem isMSDOSlike ifTrue:[
+ checkInDir := tempdir constructString:(checkoutName copyReplaceAll:$/ with:$\).
+ ] ifFalse:[
+ self error:'VMS case not yet implemented'. "/ add code for VMS ...
+ ]
+ ].
+ cmd := 'add ' , fileName , ' > ', '"' , cmdOut name, '"'.
+ (self
+ executeCVSCommand:cmd
+ module:moduleDir
+ inDirectory:checkInDir
+ ) ifFalse:[
+ 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
+
+ cmdOut remove.
+ tempdir recursiveRemove.
+ ('CVSSourceCodeManager [error]: cannot checkout ' , checkoutName) errorPrintCR.
+ ^ false.
+ ].
+ cmdOut remove.
+
+ "/
+ "/ commit
+ "/
+ self activityNotification:'committing ' , fileName.
+
+ OperatingSystem isUNIXlike ifFalse:[
+ "/ save the log message into another tempFile ...
+ logTmp := Filename newTemporaryIn:checkInDir.
+ s := logTmp writeStream.
+ s nextPutAll:'initial checkin'.
+ s close.
+
+ cmd := 'commit -F "', logTmp baseName, '" ', fileName, ' > ', '"', cmdOut name, '"'.
+ ] ifTrue:[
+ "/
+ "/ CVS up to V1.9.14 prints the 'new revision' to stderr,
+ "/ CVS V1.9.16 to stdout.
+ "/
+ cmd := 'commit -m "initial checkin" ' , fileName , ' > ', '"' , cmdOut name, '"', ' 2>&1'.
+ ].
+
+ (self
+ executeCVSCommand:cmd
+ module:moduleDir
+ inDirectory:checkInDir "tempdir name"
+ ) ifFalse:[
+ Verbose == true ifTrue:[
+ 'CVSMGR: failed to execute: ' infoPrint. cmd infoPrintCR.
+ ].
+ cmdOut fileSize > 0 ifTrue:[
+ whatHappened := cmdOut contentsOfEntireFile asString.
+ ] ifFalse:[
+ whatHappened := '<< no message >>'
+ ].
+ self warn:'The following problem was reported by cvs:
+
+' , whatHappened , '
+
+The class has NOT been checked into the repository.'.
+
+ 'CVSSourceCodeManager [error]: cannot checkin modified class source' errorPrintCR.
+ cmdOut remove.
+ tempdir recursiveRemove.
+ ^ false.
+ ].
+ whatHappened := cmdOut contentsOfEntireFile asString.
+ cmdOut remove.
+
+ "/
+ "/ release it towards cvs
+ "/
+ self releaseAndRemove:tempdir module:moduleDir outputTo:nil.
+
+ "/
+ "/ good - its in the CVS repository; now, we need the updated RCS header
+ "/
+ (whatHappened isNil or:[whatHappened isEmpty]) ifTrue:[
+ 'CVSSourceCodeManager [warning]: unexpected empty commit command output' errorPrintCR.
+ "/ TODO: scan the file for $Header ...
+ "/ and extract the revision manually
+
+ ] ifFalse:[
+ whatHappened := whatHappened asCollectionOfLines asStringCollection.
+ idx := whatHappened indexOfLineStartingWith:'initial revision:'.
+ idx ~~ 0 ifTrue:[
+ startIdx := 18
+ ] ifFalse:[
+ idx := whatHappened indexOfLineStartingWith:'new revision:'.
+ idx ~~ 0 ifTrue:[
+ 'CVSSourceCodeManager [warning]: container existed before' errorPrintCR.
+ startIdx := 14.
+ ] ifFalse:[
+ 'CVSSourceCodeManager [warning]: unexpected commit command output (no new-revision info)' errorPrintCR.
+ ]
+ ].
+ idx ~~ 0 ifTrue:[
+ l := whatHappened at:idx.
+ endIdx := (l indexOf:$; startingAt:startIdx) - 1.
+ endIdx < 0 ifTrue:[
+ endIdx := l size
+ ].
+ newRevision := (l copyFrom:startIdx to:endIdx) withoutSpaces.
+ (Number fromString:newRevision onError:nil) isNil ifTrue:[
+ newRevision := '1.1'
+ ]
+ ]
+ ].
+
+ Transcript showCR:'created new sourceContainer for ' , aClass name , '.'.
+
+ "/
+ "/ patch the classes revisionInfo (but keep binaryRevision unchanged)
+ "/ this makes everyone here believe, that the incore version of the class is based upon
+ "/ the newly checked in version.
+ "/ (however, the binaryRevision must remain as it is - we will need it to fetch the sourceCode
+ "/ correctly for all unchanged methodss)
+ "/
+
+ newRevision notNil ifTrue:[
+ changeLog := self
+ revisionLogOf:aClass
+ fromRevision:newRevision
+ toRevision:newRevision
+ fileName:fileName
+ directory:packageDir
+ module:moduleDir.
+
+ (changeLog isNil or:[(changeLog at:#revisions) size ~~ 1]) ifTrue:[
+ 'CVSSourceCodeManager [error]: failed to update revisionString (no log)' errorPrintCR
+ ] ifFalse:[
+ entry := (changeLog at:#revisions) first.
+ newString := self revisionStringFromLog:changeLog entry:entry forClass:aClass.
+ aClass updateVersionMethodFor:newString.
+ ('CVSSourceCodeManager [info]: updated revisionString to:',newString) infoPrintCR
+ ]
+ ].
+
+ tempdir recursiveRemove.
+
+ Class addChangeRecordForClassCheckIn:aClass.
+ self postCheckInClass:aClass.
+ ^ true
+
+ "Created: / 9.12.1995 / 19:13:37 / cg"
+ "Modified: / 23.7.1999 / 19:47:59 / stefan"
+ "Modified: / 5.11.2001 / 14:22:56 / cg"
+!
+
+createContainerForText:someText inModule:moduleDir package:packageDir container:fileName
+ "create a container - this does an initial checkin
+ (i.e. cvs add & cvs commit)"
+
+ |fullName tempdir checkoutName cmdOut cmd tempFile idx aStream whatHappened l newRevision
+ startIdx endIdx checkInDir logTmp s|
+
+ cmdOut := Filename newTemporary.
+ cmdOut exists ifTrue:[
+ cmdOut remove.
+ ].
+
+ fullName := moduleDir , '/' , packageDir , '/' , fileName.
+ checkoutName := moduleDir , '/' , packageDir.
+
+ "/
+ "/ first, check out everything there - this creates the CVS helpfiles
+ "/ required later.
+ "/
+
+ self activityNotification:'checking for directory ' , checkoutName.
+ tempdir := self createLocalDirectory:packageDir inModule:moduleDir.
+ tempdir isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: cannot checkout ' , checkoutName) errorPrintCR.
+ ^ false.
+ ].
+
+ [
+ "/
+ "/ create the source there
+ "/
+ tempFile := (tempdir construct:checkoutName) construct:fileName.
+ [
+ aStream := tempFile writeStream.
+ ] on:FileStream openErrorSignal do:[:ex|
+ ('CVSSourceCodeManager [error]: temporary fileout failed -> ', tempFile name) errorPrintCR.
+ ^ false
+ ].
+
+ aStream nextPutAll:someText.
+ aStream close.
+
+ tempFile exists ifFalse:[
+ 'CVSSourceCodeManager [error]: temporary fileout failed' errorPrintCR.
+ ^ false
+ ].
+
+ "/
+ "/ and add it to the repository
+ "/
+ self activityNotification:'adding ' , fileName.
+
+ OperatingSystem isUNIXlike ifTrue:[
+ checkInDir := tempdir constructString:checkoutName.
+ ] ifFalse:[
+ OperatingSystem isMSDOSlike ifTrue:[
+ checkInDir := tempdir constructString:(checkoutName copyReplaceAll:$/ with:$\).
+ ] ifFalse:[
+ self error:'VMS case not yet implemented'. "/ add code for VMS ...
+ ]
+ ].
+ cmd := 'add ' , fileName , ' > ', '"' , cmdOut name, '"'.
+ (self
+ executeCVSCommand:cmd
+ module:moduleDir
+ inDirectory:checkInDir
+ ) ifFalse:[
+ 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
+
+ cmdOut remove.
+ ('CVSSourceCodeManager [error]: cannot checkout ' , checkoutName) errorPrintCR.
+ ^ false.
+ ].
+ cmdOut remove.
+
+ "/
+ "/ commit
+ "/
+ self activityNotification:'committing ' , fileName.
+
+ OperatingSystem isUNIXlike ifFalse:[
+ "/ save the log message into another tempFile ...
+ logTmp := Filename newTemporaryIn:checkInDir.
+ s := logTmp writeStream.
+ s nextPutAll:'initial checkin'.
+ s close.
+
+ cmd := 'commit -F "', logTmp baseName, '" ', fileName, ' >', '"', cmdOut name, '"'.
+ ] ifTrue:[
+ "/
+ "/ CVS up to V1.9.14 prints the 'new revision' to stderr,
+ "/ CVS V1.9.16 to stdout.
+ "/
+ cmd := 'commit -m "initial checkin" ' , fileName , ' > ', '"' , cmdOut name, '"', ' 2>&1'.
+ ].
+
+ (self
+ executeCVSCommand:cmd
+ module:moduleDir
+ inDirectory:checkInDir "tempdir name"
+ ) ifFalse:[
+ Verbose == true ifTrue:[
+ 'CVSMGR: failed to execute: ' infoPrint. cmd infoPrintCR.
+ ].
+ cmdOut fileSize > 0 ifTrue:[
+ whatHappened := cmdOut contentsOfEntireFile asString.
+ ] ifFalse:[
+ whatHappened := '<< no message >>'
+ ].
+ self warn:'The following problem was reported by cvs:
+
+' , whatHappened , '
+
+The class has NOT been checked into the repository.'.
+
+ 'CVSSourceCodeManager [error]: cannot checkin modified class source' errorPrintCR.
+ cmdOut remove.
+ ^ false.
+ ].
+ whatHappened := cmdOut contentsOfEntireFile asString.
+ cmdOut remove.
+
+ "/
+ "/ release it towards cvs
+ "/
+ self releaseAndRemove:tempdir module:moduleDir outputTo:nil.
+
+ "/
+ "/ good - its in the CVS repository; now, we need the updated RCS header
+ "/
+ (whatHappened isNil or:[whatHappened isEmpty]) ifTrue:[
+ 'CVSSourceCodeManager [warning]: unexpected empty commit command output' errorPrintCR.
+ "/ TODO: scan the file for $Header ...
+ "/ and extract the revision manually
+
+ ] ifFalse:[
+ whatHappened := whatHappened asCollectionOfLines asStringCollection.
+ idx := whatHappened indexOfLineStartingWith:'initial revision:'.
+ idx ~~ 0 ifTrue:[
+ startIdx := 18
+ ] ifFalse:[
+ idx := whatHappened indexOfLineStartingWith:'new revision:'.
+ idx ~~ 0 ifTrue:[
+ 'CVSSourceCodeManager [warning]: container existed before' errorPrintCR.
+ startIdx := 14.
+ ] ifFalse:[
+ 'CVSSourceCodeManager [warning]: unexpected commit command output (no new-revision info)' errorPrintCR.
+ ]
+ ].
+ idx ~~ 0 ifTrue:[
+ l := whatHappened at:idx.
+ endIdx := (l indexOf:$; startingAt:startIdx) - 1.
+ endIdx < 0 ifTrue:[
+ endIdx := l size
+ ].
+ newRevision := (l copyFrom:startIdx to:endIdx) withoutSpaces.
+ (Number fromString:newRevision onError:nil) isNil ifTrue:[
+ newRevision := '1.1'
+ ]
+ ]
+ ].
+
+ Transcript showCR:'created new sourceContainer for ' , fileName , '.'.
+ ] ensure:[
+ tempdir recursiveRemove.
+ ].
+ ^ true
+!
+
+createModule:moduleName
+ "create a module directory"
+
+ |tempdir moduleDir cmdOut cmd|
+
+ "/
+ "/ first, create a temporary work tree
+ "/
+ tempdir := self createTempDirectory:nil forModule:moduleName.
+ tempdir isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: no tempDir - cannot create moduleDirectory') errorPrintCR.
+ ^ false
+ ].
+
+ cmdOut := Filename newTemporary.
+ cmdOut exists ifTrue:[
+ cmdOut remove.
+ ].
+
+ "/
+ "/ create the module directory
+ "/
+ moduleDir := tempdir construct:moduleName.
+ moduleDir exists ifFalse:[
+ 'CVSSourceCodeManager [error]: failed to create: ' errorPrint. moduleDir name errorPrintCR.
+ tempdir recursiveRemove.
+ ^ false.
+ ].
+
+ "/
+ "/ then import it into CVS
+ "/
+
+ cmd := 'import -m "created from browser" ' , moduleName , ' initialV initialR > ' , cmdOut name.
+ (self
+ executeCVSCommand:cmd
+ module:moduleName
+ inDirectory:tempdir name
+ ) ifFalse:[
+ 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
+
+ cmdOut remove.
+ tempdir recursiveRemove.
+ ^ false.
+ ].
+
+ 'CVSSourceCodeManager [info]: created new module: ' infoPrint. moduleName infoPrintCR.
+ tempdir recursiveRemove.
+ cmdOut remove.
+ ^ true
+
+ "Created: / 9.12.1995 / 19:53:51 / cg"
+ "Modified: / 7.1.1998 / 14:18:57 / stefan"
+ "Modified: / 6.6.1998 / 16:15:34 / cg"
+!
+
+createModule:moduleDirName package:packageDirName
+ "create a package directory"
+
+ |tempdir cmdOut cmd packageDir moduleDir relativePath idx parentPackage|
+
+ "/ any parent package required ?
+ idx := packageDirName lastIndexOf:$/.
+ idx ~~ 0 ifTrue:[
+ parentPackage := packageDirName copyTo:idx-1.
+ (self checkForExistingModule:moduleDirName package:parentPackage) ifFalse:[
+ (self createModule:moduleDirName package:parentPackage) ifFalse:[
+ ^ false.
+ ].
+ ].
+ ].
+
+ (moduleDirName asFilename components includes:'core') ifTrue:[
+ ('CVSSourceCodeManager [error]: cvs does not allow for a module to be named ''core'' - cannot create moduleDirectory') errorPrintCR.
+ ^ false
+ ].
+
+ "/
+ "/ first, create a temporary work tree
+ "/
+ tempdir := self createTempDirectory:packageDirName forModule:moduleDirName.
+ tempdir isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: no tempDir - cannot create moduleDirectory') errorPrintCR.
+ ^ false
+ ].
+
+ cmdOut := Filename newTemporary.
+ cmdOut exists ifTrue:[
+ cmdOut remove.
+ ].
+
+ moduleDir := tempdir construct:moduleDirName.
+ moduleDir isDirectory ifFalse:[
+ 'CVSSourceCodeManager [error]: command failed: ' errorPrint. cmd errorPrintCR.
+
+ tempdir recursiveRemove.
+ ^ false.
+ ].
+
+ "/
+ "/ create the package directory there
+ "/
+ packageDir := moduleDir construct:packageDirName.
+ OperatingSystem errorSignal catch:[
+ packageDir recursiveMakeDirectory.
+ ].
+ packageDir isDirectory ifFalse:[
+ tempdir recursiveRemove.
+ ('CVSSourceCodeManager [error]: cannot create new directory: ' , packageDir pathName) errorPrintCR.
+ ^ false.
+ ].
+
+ "/
+ "/ then import it into CVS
+ "/
+
+ relativePath := moduleDirName asFilename constructString:packageDirName.
+ cmd := 'import -m "created from browser" . initialV initialR > ' , cmdOut name.
+ (self
+ executeCVSCommand:cmd
+ module:moduleDirName
+ inDirectory:tempdir name
+ ) ifFalse:[
+ 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
+ 'CVSSourceCodeManager [error]: output from cvs:' errorPrintCR.
+ (cmdOut contentsOfEntireFile) errorPrint.
+
+ cmdOut remove.
+ tempdir recursiveRemove.
+ ^ false.
+ ].
+
+ tempdir recursiveRemove.
+ cmdOut remove.
+ ^ true
+
+ "
+ self createModule:'stefan' package:'dummy1'
+ "
+
+ "Created: / 9.12.1995 / 20:09:33 / cg"
+ "Modified: / 23.7.1999 / 18:40:49 / stefan"
+ "Modified: / 18.1.2000 / 20:14:01 / cg"
+!
+
+getExistingContainersInModule:aModule package:aPackage
+ "return a list of existing containers.
+ This does not work with remote-CVS"
+
+ |cvsRoot containers moduleDir packageDir tempdir cmdOut cmd dirName|
+
+ cvsRoot := self getCVSROOTForModule:aModule.
+ cvsRoot isNil ifTrue:[^ #() ].
+
+ dirName := aModule , '/' , aPackage.
+
+ self activityNotification:'getting list of containers in ' , dirName , ' ...'.
+
+ (RemoteCVS
+ or:[cvsRoot asFilename exists not]) ifTrue:[
+ "/ remote CVS
+ "/ filter the output of the history command
+ "/ (sigh - there ought to be some cvs-command for that)
+ "/
+
+ tempdir := self createTempDirectory:nil forModule:nil.
+ tempdir isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: no tempDir - cannot checkout') errorPrintCR.
+ ^ #()
+ ].
+
+ cmd := '-l checkout ', dirName.
+ OperatingSystem isUNIXlike ifTrue:[
+ "/ can redirect output
+ cmdOut := Filename newTemporary.
+ cmdOut exists ifTrue:[
+ cmdOut remove.
+ ].
+ cmd := cmd , ' > ' , cmdOut name.
+ ].
+
+ (self
+ executeCVSCommand:cmd
+ module:aModule
+ inDirectory:tempdir name
+ ) ifFalse:[
+ 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
+ cmdOut notNil ifTrue:[cmdOut remove].
+ tempdir recursiveRemove.
+ ^ #()
+ ].
+
+ cmdOut notNil ifTrue:[cmdOut remove].
+
+ packageDir := (tempdir construct:dirName).
+ (packageDir isDirectory) ifFalse:[
+ 'CVSSourceCodeManager [error]: checkout failed (no dir)' errorPrintCR.
+ tempdir recursiveRemove.
+ ^ #()
+ ].
+
+ "/
+ "/ enumerate the checkedOut directory, looking for plain files
+ "/
+ containers := OrderedCollection new.
+ packageDir directoryContents do:[:aFilenameString |
+ |fn|
+
+ (packageDir construct:aFilenameString) isDirectory ifFalse:[
+ containers add:aFilenameString
+ ]
+ ].
+ tempdir recursiveRemove.
+ ] ifFalse:[
+ (cvsRoot := cvsRoot asFilename) exists ifFalse:[
+ ^ #()
+ ].
+ ((moduleDir := cvsRoot construct:aModule) exists
+ and:[moduleDir isDirectory]) ifFalse:[
+ self warn:'No such module'.
+ ^ #()
+ ].
+ ((packageDir := moduleDir construct:aPackage) exists
+ and:[packageDir isDirectory]) ifFalse:[
+ self warn:'No such package'.
+ ^ #()
+ ].
+
+ "/
+ "/ enumerate the package directory, looking for container files
+ "/ strip off the ,v ending.
+ "/
+ containers := OrderedCollection new.
+ packageDir directoryContents do:[:aFilenameString |
+ |fn|
+
+ (aFilenameString endsWith:',v') ifTrue:[
+ containers add:(aFilenameString copyWithoutLast:2)
+ ]
+ ].
+ ].
+ ^ containers sort
+
+ "
+ CVSSourceCodeManager getExistingContainersInModule:'stx' package:'libhtml'
+ CVSSourceCodeManager getExistingContainersInModule:'cg' package:'java'
+ CVSSourceCodeManager getExistingContainersInModule:'sel' package:'bmti'
+ "
+
+ "Created: / 20.5.1998 / 19:48:59 / cg"
+ "Modified: / 20.5.1998 / 22:08:29 / cg"
+!
+
+getExistingModules
+ "return a list of existing modules.
+ This does not work with remote-CVS"
+
+ |cvsRoot modules inStream list|
+
+ cvsRoot := self getCVSROOTForModule:nil.
+ cvsRoot isNil ifTrue:[^ #() ].
+
+ self activityNotification:'getting list of modules...'.
+
+ (RemoteCVS
+ or:[cvsRoot asFilename exists not]) ifTrue:[
+ "/ remote CVS
+ "/ filter the output of the history command
+ "/ (sigh - there ought to be some cvs-command for that)
+ "/
+ inStream := PipeStream readingFrom:'cvs -d ' , cvsRoot , ' history -x A'.
+ inStream isNil ifTrue:[
+ self warn:'This operation is not possible with this remoteCVS server'.
+ ^ #().
+ ].
+ list := inStream contents asStringCollection.
+ inStream close.
+
+ modules := Set new.
+ list do:[:line |
+ |idx items entry|
+
+ items := line asCollectionOfWords.
+ "/ #( 'A' '10/29' '17:47' '+0000' 'cg' '1.1' '.cvsignore' 'stx' '==' '~/work/stx' )
+ "/ fetch the word before '=='
+
+ idx := items indexOf:'=='.
+ idx > 1 ifTrue:[
+ entry := items at:idx-1.
+
+ "/ extract the first directory component ...
+ idx := entry indexOf:$/.
+ idx ~~ 0 ifTrue:[
+ entry := entry copyTo:idx-1
+ ].
+ modules add:entry.
+ ]
+ ].
+ modules := modules asArray
+ ] ifFalse:[
+ "/ local CVS
+ "/
+ "/ enumerate the root directory, looking for subdirs
+ "/ which contain a CVS subdir.
+ "/
+ (cvsRoot := cvsRoot asFilename) exists ifFalse:[
+ ^ #()
+ ].
+
+ modules := OrderedCollection new.
+ cvsRoot directoryContents do:[:aFilenameString |
+ |fn|
+
+ (aFilenameString endsWith:',v') ifFalse:[
+ (#('CVS' 'CVSROOT' 'Attic') includes:aFilenameString) ifFalse:[
+ (fn := (cvsRoot construct:aFilenameString)) isDirectory ifTrue:[
+ modules add:aFilenameString
+ ]
+ ]
+ ]
+ ].
+ ].
+
+ ^ modules sort
+
+ "
+ CVSSourceCodeManager getExistingModules
+ "
+
+ "Created: / 20.5.1998 / 19:28:43 / cg"
+ "Modified: / 20.5.1998 / 22:07:07 / cg"
+!
+
+getExistingPackagesInModule:aModule
+ "return a list of existing packages.
+ This does not work with remote-CVS"
+
+ |cvsRoot packages moduleDir inStream list|
+
+ cvsRoot := self getCVSROOTForModule:aModule.
+
+ self activityNotification:'getting list of packages in ' , aModule , ' ...'.
+
+ (RemoteCVS
+ or:[cvsRoot asFilename exists not]) ifTrue:[
+ "/ remote CVS
+ "/ filter the output of the history command
+ "/ (sigh - there ought to be some cvs-command for that)
+ "/
+ inStream := PipeStream readingFrom:'cvs -d ' , cvsRoot , ' history -x A'.
+ inStream isNil ifTrue:[
+ self warn:'This operation is not possible with this remoteCVS server'.
+ ^ #().
+ ].
+ list := inStream contents asStringCollection.
+ inStream close.
+
+ packages := Set new.
+ list do:[:line |
+ |items idx entry|
+
+ items := line asCollectionOfWords.
+ "/ #( 'A' '10/29' '17:47' '+0000' 'cg' '1.1' '.cvsignore' 'stx' '==' '~/work/stx' )
+ "/ fetch the word before '=='
+
+ idx := items indexOf:'=='.
+ idx > 1 ifTrue:[
+ entry := items at:idx-1.
+
+ "/ extract the first directory component ...
+ (entry startsWith:aModule) ifTrue:[
+ idx := entry indexOf:$/.
+ idx ~~ 0 ifTrue:[
+ (entry copyTo:idx-1) = aModule ifTrue:[
+ packages add:(entry copyFrom:idx+1).
+ ]
+ ].
+ ]
+ ]
+ ].
+ packages := packages asArray
+ ] ifFalse:[
+ "/ local CVS
+ "/
+ "/ enumerate the module directory, looking for subdirs
+ "/ which contain a CVS subdir.
+ "/
+
+ (cvsRoot := cvsRoot asFilename) exists ifFalse:[
+ ^ #()
+ ].
+ (moduleDir := cvsRoot construct:aModule) isDirectory ifFalse:[
+ self warn:'No such module'.
+ ^ #()
+ ].
+
+ packages := OrderedCollection new.
+ moduleDir directoryContents do:[:aFilenameString |
+ |fn|
+
+ (aFilenameString endsWith:',v') ifFalse:[
+ (#('CVS' 'CVSROOT' 'Attic') includes:aFilenameString) ifFalse:[
+ (fn := (moduleDir construct:aFilenameString)) isDirectory ifTrue:[
+ packages add:aFilenameString
+ ]
+ ]
+ ]
+ ].
+ ].
+ ^ packages sort
+
+ "
+ CVSSourceCodeManager getExistingPackagesInModule:'stx'
+ CVSSourceCodeManager getExistingPackagesInModule:'cg'
+ CVSSourceCodeManager getExistingPackagesInModule:'sel'
+ "
+
+ "Created: / 20.5.1998 / 19:28:43 / cg"
+ "Modified: / 20.5.1998 / 22:07:13 / cg"
+!
+
+initialRevisionStringFor:aClass inModule:moduleDir package:packageDir container:fileName
+ "return a string usable as initial revision string"
+
+ |cvsRoot|
+
+ cvsRoot := self getCVSROOTForModule:moduleDir.
+ cvsRoot := self repositoryTopDirectory:cvsRoot.
+ ^ self
+ initialRCSRevisionStringFor:aClass
+ in:(cvsRoot , '/' , moduleDir , '/' , packageDir)
+ container:fileName
+
+ "Modified: / 19.9.1997 / 06:34:10 / cg"
+ "Modified: / 16.1.1998 / 17:34:13 / stefan"
+!
+
+newestRevisionInFile:classFileName directory:packageDir module:moduleDir
+ "return the newest revision found in a container.
+ Return nil on failure.
+ Uses 'cvs status', which is much faster than 'cvs log'"
+
+ |info|
+
+ info := self
+ statusOf:nil
+ fileName:classFileName
+ directory:packageDir
+ module:moduleDir.
+
+ info isNil ifTrue:[^ nil].
+ ^ info at:#newestRevision ifAbsent:nil
+
+ "
+ SourceCodeManager newestRevisionInFile:'Array.st' directory:'libbasic' module:'stx'
+ "
+!
+
+readRevisionLogEntryFromStream:inStream
+ "read and parse a single revision info-entry from the cvs log output.
+ Return nil on end.
+
+ The returned information is a structure (IdentityDictionary)
+ filled with:
+ #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
+ "
+
+ |revLine1 revLine2 record s line atEnd|
+
+ atEnd := false.
+
+ revLine1 := inStream nextLine.
+ [revLine1 notNil and:[(revLine1 startsWith:'revision ') not]]
+ whileTrue:[inStream atEnd ifTrue:[
+ revLine1 := nil
+ ] ifFalse:[
+ revLine1 := inStream nextLine.
+ ]
+ ].
+ revLine2 := inStream nextLine.
+ (revLine1 notNil and:[revLine2 notNil]) ifTrue:[
+ record := IdentityDictionary new.
+ record at:#revision put:(revLine1 asCollectionOfWords at:2).
+ "/ decompose date/author/state etc.
+ (revLine2 asCollectionOfSubstringsSeparatedBy:$;) do:[:info |
+ |subEntry|
+ subEntry := info withoutSeparators.
+ #('date:' #date
+ 'author:' #author
+ 'state:' #state
+ 'lines:' #numberOfChangedLines
+ ) pairWiseDo:[:word :key |
+ s := subEntry restAfter:word withoutSeparators:true.
+ s notNil ifTrue:[record at:key put:s.].
+ ].
+ ].
+
+ "first revision does not hav a 'lines:' entry"
+ (record includesKey:#numberOfChangedLines) ifFalse:[
+ record at:#numberOfChangedLines put:''
+ ].
+
+ s := nil.
+ line := inStream nextLine.
+ [atEnd or:[line isNil or:[line startsWith:'--------']]] whileFalse:[
+ (line startsWith:'==========') ifTrue:[
+ atEnd := true.
+ ] ifFalse:[
+ (line withoutSpaces = '.') ifTrue:[
+ line := '*** empty log message ***'
+ ].
+ s isNil ifTrue:[
+ s := line
+ ] ifFalse:[
+ s := s , Character cr asString , line.
+ ].
+ line := inStream nextLine.
+ ]
+ ].
+ record at:#logMessage put:s.
+ ].
+ ^record.
+
+!
+
+removeContainerFor:aClass inModule:moduleDir package:packageDir container:fileName
+ "remove a container"
+
+ (self removeContainerInModule:moduleDir package:packageDir container:fileName) ifFalse:[
+ ^ false
+ ].
+
+ "/
+ "/ patch the classes revisionInfo (but keep binaryRevision unchanged)
+ "/ this makes everyone here believe, that the incore version of the class is based upon
+ "/ some container-less class.
+ "/ (however, the binaryRevision must remain as it is - we will need it to fetch the sourceCode
+ "/ correctly for all unchanged methodss)
+ "/
+
+ aClass updateVersionMethodFor:'no longer in repository'.
+ Class addChangeRecordForClassContainerRemove:aClass.
+ ^ true
+!
+
+removeContainerInModule:moduleDir package:packageDir container:fileName
+ "remove a container"
+
+ |fullName tempdir checkoutName cmdOut cmd tempFile whatHappened|
+
+ fullName := moduleDir , '/' , packageDir , '/' , fileName.
+ checkoutName := moduleDir , '/' , packageDir.
+
+ (tempdir := self createLocalDirectory:packageDir inModule:moduleDir with:fileName) isNil ifTrue:[
+ 'CVSSourceCodeManager [error]: failed to checkout: ' errorPrint. checkoutName errorPrintCR.
+ tempdir recursiveRemove.
+ ('CVSSourceCodeManager [error]: cannot checkout ' , checkoutName) errorPrintCR.
+ ^ false.
+ ].
+
+ "/
+ "/ and remove it to the repository
+ "/
+ self activityNotification:'removing ' , fileName.
+
+ "/
+ "/ check presence of source there
+ "/
+ tempFile := (tempdir construct:checkoutName) construct:fileName.
+ tempFile exists ifFalse:[
+ 'CVSSourceCodeManager [error]: temporary fileout failed' errorPrintCR.
+ tempdir recursiveRemove.
+ ^ false
+ ].
+
+ tempFile exists ifTrue:[
+ tempFile remove.
+ ].
+
+ cmdOut := Filename newTemporary.
+ cmdOut exists ifTrue:[
+ cmdOut remove.
+ ].
+
+ cmd := 'remove ' , fileName , ' > ' , cmdOut name.
+ (self
+ executeCVSCommand:cmd
+ module:moduleDir
+ inDirectory:(tempdir constructString:checkoutName)
+ ) ifFalse:[
+ 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
+
+ cmdOut remove.
+ tempdir recursiveRemove.
+ ('CVSSourceCodeManager [error]: cannot remove ' , checkoutName) errorPrintCR.
+ ^ false.
+ ].
+ cmdOut remove.
+
+ "/
+ "/ commit
+ "/
+ self activityNotification:'committing removal of ' , fileName.
+
+ cmd := 'commit -m "removed container" -l ' , fileName , ' 2> ' , cmdOut name.
+ (self
+ executeCVSCommand:cmd
+ module:moduleDir
+ inDirectory:(tempdir constructString:checkoutName)
+ ) ifFalse:[
+ 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
+
+ cmdOut fileSize > 0 ifTrue:[
+ whatHappened := cmdOut contentsOfEntireFile asString.
+ ] ifFalse:[
+ whatHappened := '<< no message >>'
+ ].
+ self warn:'The following problem was reported by cvs:
+
+' , whatHappened , '
+
+The container has NOT been removed into the repository.'.
+
+ 'CVSSourceCodeManager [error]: cannot remove container' errorPrintCR.
+ cmdOut remove.
+ tempdir recursiveRemove.
+ ^ false.
+ ].
+ cmdOut remove.
+
+ "/
+ "/ release the temporary tree towards cvs
+ "/
+ self releaseAndRemove:tempdir module:moduleDir outputTo:nil.
+
+ tempdir recursiveRemove.
+ ^ true
+
+ "
+ CVSSourceCodeManager removeContainerInModule:'stx' package:'private' container:'WorldPO.st'
+ "
+
+ "Modified: / 26.2.1998 / 17:33:57 / stefan"
+ "Modified: / 18.1.2000 / 21:02:30 / cg"
+!
+
+reportHistoryLogSince:timeGoal filterSTSources:filter filterUser:userFilter filterRepository:filterRep filterModules:filterModules inTo:aBlock
+ "process a full historyLog, evaluate aBlock for each entry, passing
+ the logs info in a dictionary.
+ This walks over all possible repositories.
+ filterRep may be a collection of repository names
+ (i.e. 'stc', 'exept', 'phx' etc.) to only report changes made to one
+ of those repositories.
+ filterUser, if non-nil, will filter only changes made by that user."
+
+ |inStream line words recordType fileName user date time rev pkgDir module idx
+ clsName cls clsRev roots info tempDir endReached|
+
+ CVSRoot isNil ifTrue:[
+ 'CVSSourceCodeManager [info]: CVSROOT not set' infoPrintCR.
+ ^ nil
+ ].
+
+ CVSModuleRoots notNil ifTrue:[
+ roots := Set withAll:(CVSModuleRoots values)
+ ] ifFalse:[
+ roots := Set new.
+ ].
+ roots add:CVSRoot.
+
+ "/ must do it in a tempDir, to avoid cvs validating the -D arg
+ "/ against any info found in CVS/Root
+
+ tempDir := self createTempDirectory:nil forModule:nil.
+ tempDir isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: no tempDir - cannot extract log') errorPrintCR.
+ ^ nil.
+ ].
+
+ roots do:[:aCVSRoot |
+ |root host cmd|
+
+ cmd := 'cvs -d ' , aCVSRoot.
+
+ "/ workaround a CVS bug ...
+ "/ cvs crashes with:
+ "/ cvs -d exept:/files/CVS history -x WARM -a -D "yesterday"
+ "/
+ "/ but works ok, when doing:
+ "/ rsh exept cvs -d /files/CVS history -x WARM -a -D "yesterday"
+ "/
+ (aCVSRoot startsWith:':') ifFalse:[
+ OperatingSystem isUNIXlike ifTrue:[
+ host := aCVSRoot copyTo:(aCVSRoot indexOf:$:)-1.
+ (host size > 0 and:[(host includes:Character space) not]) ifTrue:[
+ root := aCVSRoot copyFrom:(aCVSRoot indexOf:$:)+1.
+ cmd := 'rsh ' , host , ' cvs -d ' , root
+ ]
+ ]
+ ].
+
+ cmd := cmd , ' history -x WARM -a'.
+ (timeGoal notNil and:[timeGoal notEmpty]) ifTrue:[
+ cmd := cmd , ' -D "' , timeGoal , '"'.
+ ].
+ filterRep notNil ifTrue:[
+ filterRep do:[:aRepository |
+ cmd := cmd , ' -p "' , aRepository , '"'.
+ ].
+ ].
+ userFilter notNil ifTrue:[
+ userFilter isString ifTrue:[
+ cmd := cmd , ' -u "' , userFilter , '"'.
+ ] ifFalse:[
+ userFilter do:[:user |
+ cmd := cmd , ' -u "' , user , '"'.
+ ].
+ ].
+ ].
+
+"/ either I dont understand CVS, or it does not work correctly...
+"/ in any case, the -m option does NOT filter modules. (sigh)
+"/
+"/ filterModules notNil ifTrue:[
+"/ filterModules do:[:aModule |
+"/ cmd := cmd , ' -m "' , aModule , '"'.
+"/ ].
+"/ ].
+
+ Transcript showCR:cmd.
+
+ inStream := PipeStream readingFrom:cmd inDirectory:tempDir.
+ inStream isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: cannot open pipe to ''cvs history''') errorPrintCR.
+ ] ifFalse:[
+
+ inStream class streamErrorSignal handle:[:ex |
+ ('CVSSourceCodeManager [error]: pipe read error (''cvs history'')') errorPrintCR.
+ ex return.
+ ] do:[
+ "/
+ "/ read the commands pipe output and reformat the lines
+ "/
+ endReached := false.
+ [endReached] whileFalse:[
+ inStream readWait.
+ line := inStream nextLine.
+ (endReached := line isNil) ifFalse:[
+
+ "/ cvs history line is of the following format:
+ "/ [Ma] date time +xxx user rev name module/package ....
+ words := line asCollectionOfWords.
+ words size >= 8 ifFalse:[
+ "/ something like 'No records selected' ...
+
+ ] ifTrue:[
+ recordType := words at:1.
+ fileName := words at:7.
+ user := words at:5.
+
+ (filter not
+ or:[fileName endsWith:'.st']) ifTrue:[
+ (userFilter isNil
+ or:[userFilter = user]) ifTrue:[
+
+ date := words at:2.
+ time := words at:3.
+ rev := words at:6.
+ pkgDir := words at:8.
+
+ module := pkgDir copy.
+ (module startsWith:'./') ifTrue:[
+ module := module copyFrom:3.
+ ].
+ idx := module indexOf:$/.
+ idx ~~ 0 ifTrue:[
+ module at:idx put:$:
+ ].
+
+ (filterModules isNil
+ or:[filterModules includes:module]) ifTrue:[
+
+ recordType = 'M' ifTrue:[
+ recordType := ' '
+ ] ifFalse:[
+ recordType = 'A' ifTrue:[
+ recordType := '+'
+ ] ifFalse:[
+ (recordType = 'R' or:[recordType = 'W']) ifTrue:[
+ recordType := '-'
+ ]
+ ]
+ ].
+
+ info := Dictionary new.
+ info at:#cvsRecordType put:recordType.
+ info at:#date put:date.
+ info at:#time put:time.
+ info at:#user put:user.
+ info at:#fileName put:fileName.
+ info at:#revision put:rev.
+ info at:#directory put:pkgDir.
+ info at:#className put:(Smalltalk classNameForFile:fileName).
+
+ "/
+ "/ for your convenience:
+ "/ check what the actual version is in the image
+ "/
+ clsName := Smalltalk classNameForFile:fileName.
+ clsName notNil ifTrue:[
+ cls := Smalltalk classNamed:clsName.
+ (cls notNil and:[(clsRev := cls revision) notNil]) ifTrue:[
+ info at:#classesRevision put:clsRev.
+ ].
+ ].
+ aBlock value:info
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ ].
+ inStream close.
+ ]
+ ].
+
+ tempDir recursiveRemove.
+
+ "Created: / 17.1.2001 / 13:11:20 / cg"
+ "Modified: / 17.1.2001 / 13:41:22 / cg"
+!
+
+reportHistoryLogSince:timeGoal filterSTSources:filter filterUser:userFilter filterRepository:filterRep inTo:aBlock
+ "process a full historyLog, evaluate aBlock for each entry, passing
+ the logs info in a dictionary.
+ This walks over all possible repositories.
+ filterRep may be a collection of repository names
+ (i.e. 'stc', 'exept', 'phx' etc.) to only report changes made to one
+ of those repositories.
+ filterUser, if non-nil, will filter only changes made by that user."
+
+ ^self
+ reportHistoryLogSince:timeGoal
+ filterSTSources:filter
+ filterUser:userFilter
+ filterRepository:filterRep
+ filterModules:nil
+ inTo:aBlock
+
+ "Modified: / 17.1.2001 / 13:12:15 / cg"
+!
+
+revisionInfoFromString:aString
+ "{ Pragma: +optSpace }"
+
+ "return a dictionary filled with revision info.
+ This extracts the relevant info from aString."
+
+ ^ self revisionInfoFromRCSString:aString
+
+ "
+ self revisionInfoFromString:(Array version)
+ "
+
+ "Modified: 29.1.1997 / 19:00:35 / cg"
+!
+
+revisionLogOf:clsOrNil fromRevision:rev1 toRevision:rev2 fileName: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/CVS container file name
+ #cvsRoot -> the CVS root (repository)
+ #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)
+
+ 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, all logEntries are extracted.
+ -If both are 0 (not 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)
+ "
+
+ |tempDir fullName modulePath inStream inHeaderInfo atEnd line revArg idx
+ info record revisionRecords s headerOnly msg |
+
+ modulePath := moduleDir , '/' , packageDir.
+ fullName := modulePath , '/' , classFileName.
+ tempDir := self createTempDirectory:nil forModule:nil.
+ tempDir isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: no tempDir - cannot extract log') errorPrintCR.
+ ^ nil.
+ ].
+
+ [
+ self createEntryFor:fullName
+ module:moduleDir
+ in:(tempDir construct:modulePath)
+ revision:'1.1'
+ date:'dummy'
+ special:''
+ overwrite:false.
+
+ revArg := ''.
+ headerOnly := false.
+ (rev1 notNil or:[rev2 notNil]) ifTrue:[
+ (rev1 == 0 and:[rev2 == 0]) ifTrue:[
+ revArg := '-h'.
+ headerOnly := true.
+ ] ifFalse:[
+ revArg := '-r'.
+ rev1 notNil ifTrue:[
+ revArg := revArg , rev1
+ ].
+ revArg := revArg , ':'.
+ rev2 notNil ifTrue:[
+ revArg := revArg , rev2
+ ].
+ ]
+ ].
+
+ headerOnly ifTrue:[
+ msg := 'fetching revision info '
+ ] ifFalse:[
+ msg := 'reading revision log '
+ ].
+ clsOrNil isNil ifTrue:[
+ msg := msg , 'in ' , fullName.
+ ] ifFalse:[
+ msg := msg , 'of ', clsOrNil name.
+ ].
+ self activityNotification:msg.
+
+ inStream := self
+ executeCVSCommand:('log ' , revArg , ' ' , fullName)
+ module:moduleDir
+ inDirectory:tempDir
+ log:true
+ pipe:true.
+
+ inStream isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: cannot open pipe to cvs log ', fullName) errorPrintCR.
+ ^ nil
+ ].
+
+ "/
+ "/ read the commands pipe output and extract the container info
+ "/
+ info := IdentityDictionary new.
+ inHeaderInfo := true.
+ [inHeaderInfo and:[inStream atEnd not]] whileTrue:[
+ line:= inStream nextLine.
+ line notNil ifTrue:[
+ |gotIt|
+
+ gotIt := false.
+ #('RCS file:' #container
+ 'Working file:' #filename
+ 'head:' #newestRevision
+ 'total revisions:' #numberOfRevisions
+ ) pairWiseDo:[:word :key |
+ gotIt ifFalse:[
+ s := line restAfter:word withoutSeparators:true.
+ s notNil ifTrue:[info at:key put:s. gotIt := true].
+ ]
+ ].
+ gotIt ifFalse:[
+ (line startsWith:'description:') ifTrue:[inHeaderInfo := false].
+ ]
+ ]
+ ].
+ inStream nextLine. "/ skip separating line after description.
+
+ info isEmpty ifTrue:[
+ ('CVSSourceCodeManager [warning]: no log for ', fullName) errorPrintCR.
+ ^ nil
+ ].
+
+ "/ strip selected revisions from the total-revisions entry
+ s := info at:#numberOfRevisions.
+ (idx := s indexOf:$;) ~~ 0 ifTrue:[
+ info at:#numberOfRevisions put:(Integer readFrom:(s copyTo:idx - 1))
+ ] ifFalse:[
+ info at:#numberOfRevisions put:(Integer readFrom:s onError:[1])
+ ].
+ headerOnly ifFalse:[
+ "/
+ "/ continue to read the commands pipe output
+ "/ and extract revision info records
+ "/
+ revisionRecords := OrderedCollection new:(info at:#numberOfRevisions).
+ info at:#revisions put:revisionRecords.
+
+ atEnd := false.
+ [atEnd or:[inStream atEnd]] whileFalse:[
+ record := self readRevisionLogEntryFromStream:inStream.
+
+"/ revLine1 := inStream nextLine.
+"/ [revLine1 notNil and:[(revLine1 startsWith:'revision ') not]]
+"/ whileTrue:[inStream atEnd ifTrue:[
+"/ revLine1 := nil
+"/ ] ifFalse:[
+"/ revLine1 := inStream nextLine.]].
+"/ revLine2 := inStream nextLine.
+"/ (revLine1 notNil and:[revLine2 notNil]) ifTrue:[
+"/ record := IdentityDictionary new.
+"/ record at:#revision put:(revLine1 asCollectionOfWords at:2).
+"/ "/ decompose date/author/state etc.
+"/ (revLine2 asCollectionOfSubstringsSeparatedBy:$;) do:[:info |
+"/ |subEntry|
+"/ subEntry := info withoutSeparators.
+"/ #('date:' #date
+"/ 'author:' #author
+"/ 'state:' #state
+"/ 'lines:' #numberOfChangedLines
+"/ ) pairWiseDo:[:word :key |
+"/ s := subEntry restAfter:word withoutSeparators:true.
+"/ s notNil ifTrue:[record at:key put:s.].
+"/ ].
+"/ ].
+"/
+"/ "first revision does not hav a 'lines:' entry"
+"/ (record includesKey:#numberOfChangedLines) ifFalse:[
+"/ record at:#numberOfChangedLines put:''
+"/ ].
+"/
+"/ s := nil.
+"/ line := inStream nextLine.
+"/ [atEnd or:[line isNil or:[line startsWith:'--------']]] whileFalse:[
+"/ (line startsWith:'==========') ifTrue:[
+"/ atEnd := true.
+"/ ] ifFalse:[
+"/ (line withoutSpaces = '.') ifTrue:[
+"/ line := '*** empty log message ***'
+"/ ].
+"/ s isNil ifTrue:[
+"/ s := line
+"/ ] ifFalse:[
+"/ s := s , Character cr asString , line.
+"/ ].
+"/ line := inStream nextLine.
+"/ ]
+"/ ].
+"/ record at:#logMessage put:s.
+"/ revisionRecords add:record.
+"/ ]
+ record isNil ifTrue:[
+ atEnd := true.
+ ] ifFalse:[
+ revisionRecords add:record.
+ ]
+ ].
+ ].
+ ] ensure:[
+ inStream notNil ifTrue:[inStream close].
+ tempDir recursiveRemove
+ ].
+ ^ info
+
+ "
+ SourceCodeManager revisionLogOf:Array
+ SourceCodeManager revisionLogOf:Array fromRevision:'1.40' toRevision:'1.43'
+ SourceCodeManager revisionLogOf:Array fromRevision:'1.40' toRevision:nil
+ SourceCodeManager revisionLogOf:Array fromRevision:nil toRevision:'1.3'
+ SourceCodeManager revisionLogOf:Array fromRevision:nil toRevision:nil
+ SourceCodeManager revisionLogOf:Array fromRevision:0 toRevision:0
+ "
+
+ "Created: / 16.11.1995 / 13:25:30 / cg"
+ "Modified: / 29.1.1997 / 16:51:30 / stefan"
+ "Modified: / 27.8.1998 / 12:40:59 / cg"
+!
+
+revisionLogOf:clsOrNil numberOfRevisions:numRevisions fileName:classFileName directory:packageDir module:moduleDir
+ "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)
+
+ 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, all logEntries are extracted.
+ -If both are 0 (not 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)
+ "
+
+ |tempDir fullName modulePath inStream inHeaderInfo atEnd line revArg idx
+ info record revisionRecords s msg|
+
+ modulePath := moduleDir , '/' , packageDir.
+ fullName := modulePath , '/' , classFileName.
+ tempDir := self createTempDirectory:nil forModule:nil.
+ tempDir isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: no tempDir - cannot extract log') errorPrintCR.
+ ^ nil.
+ ].
+
+ [
+ self createEntryFor:fullName
+ module:moduleDir
+ in:(tempDir construct:modulePath)
+ revision:'1.1'
+ date:'dummy'
+ special:''
+ overwrite:false.
+
+ revArg := ''.
+
+ msg := 'reading revision log '.
+ clsOrNil isNil ifTrue:[
+ msg := msg , 'in ' , fullName.
+ ] ifFalse:[
+ msg := msg , 'of ', clsOrNil name.
+ ].
+ self activityNotification:msg.
+
+ inStream := self
+ executeCVSCommand:('log ' , revArg , ' ' , fullName)
+ module:moduleDir
+ inDirectory:tempDir
+ log:true
+ pipe:true.
+
+ inStream isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: cannot open pipe to cvs log ', fullName) errorPrintCR.
+ ^ nil
+ ].
+
+ "/
+ "/ read the commands pipe output and extract the container info
+ "/
+ info := IdentityDictionary new.
+ inHeaderInfo := true.
+ [inHeaderInfo and:[inStream atEnd not]] whileTrue:[
+ line:= inStream nextLine.
+ line notNil ifTrue:[
+ |gotIt|
+
+ gotIt := false.
+ #('RCS file:' #container
+ 'Working file:' #filename
+ 'head:' #newestRevision
+ 'total revisions:' #numberOfRevisions
+ ) pairWiseDo:[:word :key |
+ gotIt ifFalse:[
+ s := line restAfter:word withoutSeparators:true.
+ s notNil ifTrue:[info at:key put:s. gotIt := true].
+ ]
+ ].
+ gotIt ifFalse:[
+ (line startsWith:'description:') ifTrue:[inHeaderInfo := false].
+ ]
+ ]
+ ].
+ inStream nextLine. "/ skip separating line after description.
+
+ info isEmpty ifTrue:[
+ ('CVSSourceCodeManager [warning]: no log for ', fullName) errorPrintCR.
+ ^ nil
+ ].
+
+ "/ strip selected revisions from the total-revisions entry
+ s := info at:#numberOfRevisions.
+ (idx := s indexOf:$;) ~~ 0 ifTrue:[
+ info at:#numberOfRevisions put:(Integer readFrom:(s copyTo:idx - 1))
+ ] ifFalse:[
+ info at:#numberOfRevisions put:(Integer readFrom:s onError:[1])
+ ].
+
+ "/
+ "/ continue to read the commands pipe output
+ "/ and extract revision-info records
+ "/
+ revisionRecords := OrderedCollection new:(info at:#numberOfRevisions).
+ info at:#revisions put:revisionRecords.
+
+ atEnd := false.
+ [atEnd or:[inStream atEnd]] whileFalse:[
+ record := self readRevisionLogEntryFromStream:inStream.
+ record isNil ifTrue:[
+ atEnd := true.
+ ] ifFalse:[
+ revisionRecords add:record.
+ ].
+ (numRevisions notNil and:[revisionRecords size >= numRevisions]) ifTrue:[
+ atEnd := true
+ ]
+ ].
+ ] ensure:[
+ inStream notNil ifTrue:[inStream shutDown "close"].
+ tempDir recursiveRemove
+ ].
+ ^ info
+
+ "
+ SourceCodeManager revisionLogOf:Array
+ SourceCodeManager revisionLogOf:Array numberOfRevisions:5
+
+ "
+!
+
+statusOf:clsOrNil fileName:classFileName directory:packageDir module:moduleDir
+ "return info about the status repository container.
+ Return nil on failure.
+
+ The returned information is a structure (IdentityDictionary)
+ filled with:
+ #newestRevision -> the revisionString of the newest revision
+
+ This is much faster than revisionLog info (especially, if there are many revisions),
+ and all we need is a classes newest version number.
+ "
+
+ |tempDir fullName modulePath inStream line
+ info s msg|
+
+ modulePath := moduleDir , '/' , packageDir.
+ fullName := modulePath , '/' , classFileName.
+ tempDir := self createTempDirectory:nil forModule:nil.
+ tempDir isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: no tempDir - cannot extract log') errorPrintCR.
+ ^ nil.
+ ].
+
+ [
+ self createEntryFor:fullName
+ module:moduleDir
+ in:(tempDir construct:modulePath)
+ revision:'1.1'
+ date:'dummy'
+ special:''
+ overwrite:false.
+
+ msg := 'fetching status info of '.
+ clsOrNil isNil ifTrue:[
+ msg := msg , fullName.
+ ] ifFalse:[
+ msg := msg , clsOrNil name.
+ ].
+ self activityNotification:msg.
+
+ inStream := self
+ executeCVSCommand:('status ' , fullName)
+ module:moduleDir
+ inDirectory:tempDir
+ log:true
+ pipe:true.
+
+ inStream isNil ifTrue:[
+ ('CVSSourceCodeManager [error]: cannot open pipe to cvs log ', fullName) errorPrintCR.
+ ^ nil
+ ].
+
+ "/
+ "/ read the commands pipe output and extract the container info
+ "/
+ info := IdentityDictionary new.
+ [inStream atEnd] whileFalse:[
+ line:= inStream nextLine.
+ line notNil ifTrue:[
+ line := line withoutSeparators.
+ ].
+ line size > 0 ifTrue:[
+ |gotIt i|
+
+ gotIt := false.
+ #(
+ 'Repository revision:' #newestRevision
+ ) pairWiseDo:[:word :key |
+ gotIt ifFalse:[
+ s := line restAfter:word withoutSeparators:true.
+ s notNil ifTrue:[
+ i := s indexOfSeparator.
+ i ~~ 0 ifTrue:[
+ s := s copyTo:i-1
+ ].
+ info at:key put:s.
+ gotIt := true.
+ ].
+ ]
+ ].
+ ]
+ ].
+ info isEmpty ifTrue:[
+ ('CVSSourceCodeManager [warning]: no status for ', fullName) errorPrintCR.
+ ^ nil
+ ].
+ ] ensure:[
+ inStream notNil ifTrue:[inStream close].
+ tempDir recursiveRemove
+ ].
+ ^ info
+
+ "
+ SourceCodeManager statusOf:Array
+ SourceCodeManager statusOf:Array fileName:'Array.st' directory:'libbasic' module:'stx'
+ SourceCodeManager statusOf:Filename fileName:'Filename.st' directory:'libbasic' module:'stx'
+ SourceCodeManager statusOf:NewSystemBrowser fileName:'NewSystemBrowser.st' directory:'libtool' module:'stx'
+ "
+! !
+
+!CVSSourceCodeManager class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libbasic3/CVSSourceCodeManager.st,v 1.280 2003-12-12 15:08:19 cg Exp $'
+! !
CVSSourceCodeManager initialize!