added:
authorClaus Gittinger <cg@exept.de>
Tue, 19 Apr 2011 13:47:12 +0200
changeset 13342 0b860362f6f9
parent 13341 69f0a940013d
child 13343 3f058ad0d2f1
added: #findVersionMethodOfManager: #revisionInfoOfManager: #revisionStringOfManager: changed: #findVersionMethod #nameOfVersionMethod #revisionInfo #revisionString per manager revision info
Class.st
--- 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 $'
 ! !