added:
#findVersionMethodOfManager:
#revisionInfoOfManager:
#revisionStringOfManager:
changed:
#findVersionMethod
#nameOfVersionMethod
#revisionInfo
#revisionString
per manager revision info
--- a/Class.st Tue Apr 19 11:04:01 2011 +0200
+++ b/Class.st Tue Apr 19 13:47:12 2011 +0200
@@ -1818,7 +1818,6 @@
"Modified: 4.6.1997 / 14:48:02 / cg"
! !
-
!Class methodsFor:'changes management'!
addChangeRecordForChangeCategory
@@ -4141,25 +4140,45 @@
"return my revision method. Either this is the sourceCodeManager-specific versionMethod,
or the fallBack (for backward compatibility)"
- |owner cls meta versionMethodsToTry|
+ |owner|
(owner := self owningClass) notNil ifTrue:[^ owner findVersionMethod].
+ ^ self findVersionMethodOfManager:self sourceCodeManager
+
+ "
+ Smalltalk allClassesDo:[:cls |
+ Transcript show:cls name; show:' -> '; showCR:cls findVersionMethod
+ ].
+
+ Number findVersionMethod
+ FileDirectory findVersionMethod
+ Metaclass findVersionMethod
+ Class findVersionMethod
+ "
+
+ "Modified: / 19-04-2011 / 13:30:42 / cg"
+!
+
+findVersionMethodOfManager:aSourceCodemanagerOrNil
+ "{ Pragma: +optSpace }"
+
+ "return my revision method. Either this is the sourceCodeManager-specific versionMethod,
+ or the fallBack (for backward compatibility)"
+
+ |owner cls meta versionMethodsToTry|
+
+ (owner := self owningClass) notNil ifTrue:[^ owner findVersionMethodOfManager:aSourceCodemanagerOrNil].
meta := self theMetaclass.
cls := self theNonMetaclass.
"/ allow for sc-manager-specific version methods,
"/ before falling back to the default version method.
- versionMethodsToTry :=
- OrderedCollection streamContents:[:s |
- |sourceCodeManager|
-
- sourceCodeManager := self sourceCodeManager.
- sourceCodeManager notNil ifTrue:[
- s nextPut:(sourceCodeManager nameOfVersionMethodInClasses)
- ].
- s nextPut:self nameOfVersionMethod
- ].
+ versionMethodsToTry := OrderedCollection new.
+ aSourceCodemanagerOrNil notNil ifTrue:[
+ versionMethodsToTry add:aSourceCodemanagerOrNil nameOfVersionMethodInClasses.
+ ].
+ versionMethodsToTry add:self nameOfVersionMethod. "/ fallback
versionMethodsToTry do:[:versionMethodsName |
|aVersionMethod val|
@@ -4186,6 +4205,8 @@
Metaclass findVersionMethod
Class findVersionMethod
"
+
+ "Created: / 19-04-2011 / 13:30:05 / cg"
!
localSourceStreamFor:sourceFile
@@ -4303,7 +4324,12 @@
!
nameOfVersionMethod
+ "this is now more ore less obsolete, as multiple sourceCodeManagers might use
+ different version_XXX methods. Keep this for backward compatibility."
+
^ #version
+
+ "Modified: / 19-04-2011 / 13:42:18 / cg"
!
packageSourceCodeInfo
@@ -4567,21 +4593,7 @@
repositoryPath - the classes source container
"
- |vsnString info mgr|
-
- vsnString := self revisionString.
- vsnString notNil ifTrue:[
- mgr := self sourceCodeManager.
- mgr notNil ifTrue:[
- info := mgr revisionInfoFromString:vsnString
- ] ifFalse:[
- info := Class revisionInfoFromString:vsnString.
- ].
- info notNil ifTrue:[
- info binaryRevision:self binaryRevision.
- ]
- ].
- ^ info
+ ^ self revisionInfoOfManager:self sourceCodeManager
"
Object revisionString
@@ -4591,7 +4603,51 @@
"Created: / 11-11-1995 / 14:27:20 / cg"
"Modified: / 26-03-1997 / 00:13:17 / stefan"
- "Modified: / 22-10-2008 / 20:35:53 / cg"
+ "Modified: / 19-04-2011 / 13:41:24 / cg"
+!
+
+revisionInfoOfManager:aSourceCodemanagerOrNil
+ "return an object filled with revision info.
+ This extracts the relevant info from the revisionString.
+ The revisionInfo contains all or a subset of:
+ binaryRevision - the revision upon which the binary of this class is based
+ revision - the revision upon which the class is based logically
+ (different, if a changed class was checked in, but not yet recompiled)
+ user - the user who checked in the logical revision
+ date - the date when the logical revision was checked in
+ time - the time when the logical revision was checked in
+ fileName - the classes source file name
+ repositoryPath - the classes source container
+ "
+
+ |vsnString info|
+
+ aSourceCodemanagerOrNil notNil ifTrue:[
+ vsnString := self revisionStringOfManager:aSourceCodemanagerOrNil.
+ ].
+ vsnString isNil ifTrue:[
+ vsnString := self revisionStringOfManager:nil.
+ ].
+ vsnString isNil ifTrue:[^ nil].
+
+ aSourceCodemanagerOrNil notNil ifTrue:[
+ info := aSourceCodemanagerOrNil revisionInfoFromString:vsnString
+ ] ifFalse:[
+ info := Class revisionInfoFromString:vsnString.
+ ].
+ info notNil ifTrue:[
+ info binaryRevision:self binaryRevision.
+ ].
+ ^ info
+
+ "
+ Object revisionString
+ Object revisionInfo
+ Image revisionInfo
+ "
+
+ "Modified: / 26-03-1997 / 00:13:17 / stefan"
+ "Created: / 19-04-2011 / 13:41:13 / cg"
!
revisionString
@@ -4603,11 +4659,38 @@
If the receiver is unloaded, or the source is not accessable,
or no such method exists, then nil is returned."
+ ^ self revisionStringOfManager:nil
+
+ "
+ Smalltalk allClassesDo:[:cls |
+ Transcript show:cls name; show:' -> '; showCR:cls revisionString
+ ].
+
+ Number revisionString
+ FileDirectory revisionString
+ Metaclass revisionString
+ "
+
+ "Created: / 29-10-1995 / 19:28:03 / cg"
+ "Modified: / 01-04-1997 / 23:37:25 / stefan"
+ "Modified: / 07-02-2001 / 18:03:39 / ps"
+ "Modified: / 19-04-2011 / 13:38:07 / cg"
+!
+
+revisionStringOfManager:aSourceCodeManagerOrNil
+ "{ Pragma: +optSpace }"
+
+ "return my revision string; that one is extracted from the
+ classes #version method. Either this is a method returning that string,
+ or it's a comment-only method and the comment defines the version.
+ If the receiver is unloaded, or the source is not accessable,
+ or no such method exists, then nil is returned."
+
|owner versionMethod|
(owner := self owningClass) notNil ifTrue:[^ owner revisionString].
- versionMethod := self findVersionMethod.
+ versionMethod := self findVersionMethodOfManager:aSourceCodeManagerOrNil.
versionMethod notNil ifTrue:[
^ versionMethod valueWithReceiver:(self theNonMetaclass) arguments:#()
].
@@ -4623,10 +4706,9 @@
Metaclass revisionString
"
- "Created: / 29-10-1995 / 19:28:03 / cg"
"Modified: / 01-04-1997 / 23:37:25 / stefan"
"Modified: / 07-02-2001 / 18:03:39 / ps"
- "Modified: / 22-10-2008 / 20:33:49 / cg"
+ "Created: / 19-04-2011 / 13:37:42 / cg"
!
setBinaryRevision:aString
@@ -5151,9 +5233,9 @@
!Class class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.579 2011-01-18 19:41:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.580 2011-04-19 11:47:12 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.579 2011-01-18 19:41:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.580 2011-04-19 11:47:12 cg Exp $'
! !