Class.st
changeset 15947 edce1c1a0ab9
parent 15821 5ba671bedf2e
child 16020 fa71b75a7550
--- a/Class.st	Wed Feb 05 18:12:41 2014 +0100
+++ b/Class.st	Wed Feb 05 18:12:55 2014 +0100
@@ -151,7 +151,10 @@
      the meantime. You have been warned - better leave it false (the sourceCodemanager will
      fill its cache and eventually be just as fast...)"
 
-    ^ TryLocalSourceFirst
+    "JV: When smalltalk is not yet initialized, do use local sources
+         because before that, SCM support may not be loaded and configured
+         properly, leading to funny errors."
+    ^ Smalltalk isInitialized not or:[TryLocalSourceFirst == true].
 
     "Created: 24.1.1996 / 19:55:35 / cg"
 !
@@ -364,25 +367,30 @@
 
     lines := aMethodSourceString asCollectionOfLines.
     lines do:[:l |
-	|i|
-
-	i := l indexOfSubCollection:'$Header: '.
-	"JV @ 2009-12-13: Also search for '$Id: ' (because of SVN-only classes)"
-	i == 0 ifTrue:[
-	i := l indexOfSubCollection:'$Id: '].
-	i ~~ 0 ifTrue:[
-	    line := l copyFrom:i.
-	    i := line lastIndexOf:$$.
-	    i > 1 ifTrue:[
-		line := line copyTo:i.
-	    ].
-	    ^ line
-	]
+        |i|
+
+        i := l indexOfSubCollection:'$Header: '.
+        "JV @ 2009-12-13: Also search for '$Id: ' (because of SVN-only classes)"
+        i == 0 ifTrue:[
+        i := l indexOfSubCollection:'$Id: '].
+        "JV @ 2013-07-18: Also search for '$Changeset: ' (because of Mercurial-only classes)"
+        i == 0 ifTrue:[
+        i := l indexOfSubCollection:'$Changeset: '].
+
+        i ~~ 0 ifTrue:[
+            line := l copyFrom:i.
+            i := line lastIndexOf:$$.
+            i > 1 ifTrue:[
+                line := line copyTo:i.
+            ].
+            ^ line
+        ]
     ].
     ^ nil
 
     "Created: / 15-10-1996 / 18:57:57 / cg"
     "Modified: / 22-10-2008 / 20:29:50 / cg"
+    "Modified: / 19-07-2013 / 23:32:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !Class class methodsFor:'misc'!
@@ -1732,6 +1740,70 @@
     "Modified: / 05-12-2006 / 22:04:26 / cg"
 !
 
+sourceCodeManagerFromBinaryRevision
+
+    "Returns the source code manager that should be used for
+     source code access based in class's binary revision.
+     If not binary revision is available, then configured source
+     code manager is returned. If source code management
+     is disabled or particular source code manager is not enabled,
+     return nil.
+
+     Source code manager for source access may differ from
+     configured source code manager:
+
+     - #sourceCodeManager returns the manager use has configured for
+       this class using preferences
+
+     - #sourceCodeManagerForSourceAccess is the manager used when asking
+       for class source code. It compares version_XXX methods with
+       class's binary revision and. When method_XXX matches the
+       binary revision string, XXX source code manager is returned,
+       as this class has been likely compiled from a source checked out
+       using returned source code manager
+
+    CAVEAT: Now, the code expects that the revision string is in
+    format '$revision ident$SCM'. It won't work for managers that
+    does not use dollar expansion. For, only CVS, SVN and Perforce
+    are used so this code should work
+    "
+
+
+
+
+    revision ifNil:[^self sourceCodeManager].
+
+    AbstractSourceCodeManager availableManagers do:[:mgr|
+        (revision endsWith: mgr managerTypeNameShort) ifTrue:[
+            ^mgr
+        ]
+    ].
+
+    "binary revision is not nil and we haven't found source code manager.
+     This may happen when (i) given source code manager is not available
+     or (ii) source version methods are somehow corrupted.
+
+     Let's be strict about it for now and throw and error. More relaxed
+     version may simply return nil"
+
+"/    self error:'Cannot find source code manager for source access ' ,
+"/               '(manager yet not loaded or binary revision corrupted)'
+"/        mayProceed: true.
+
+    ^nil
+
+
+    "
+        Object sourceCodeManager
+        Object sourceCodeManagerForSourceAccess
+
+        JavaVM sourceCodeManager
+        JavaVM sourceCodeManagerForSourceAccess
+    "
+
+    "Created: / 06-10-2011 / 09:33:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 subclasses
     "return a collection of the direct subclasses of the receiver"
 
@@ -1807,7 +1879,6 @@
     "Created: / 18-07-2011 / 09:14:38 / cg"
 ! !
 
-
 !Class methodsFor:'adding & removing'!
 
 removeFromSystem
@@ -2626,9 +2697,10 @@
 fileOutDefinitionOn:aStream
     "append an expression on aStream, which defines myself."
 
-    ^ self basicFileOutDefinitionOn:aStream withNameSpace:false
-
-    "Modified: 4.1.1997 / 20:55:18 / cg"
+    ^ self basicFileOutDefinitionOn:aStream withNameSpace:true
+
+    "Modified: / 04-01-1997 / 20:55:18 / cg"
+    "Modified: / 04-02-2014 / 16:49:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 fileOutIn:aDirectoryName
@@ -4233,20 +4305,23 @@
      If a classes binary is up-to-date w.r.t. the source repository,
      the returned string is the same as the one returned by #revision."
 
-    |owner info c|
+    |owner manager info c|
 
     (owner := self owningClass) notNil ifTrue:[^ owner binaryRevision].
 
     revision notNil ifTrue:[
-	c := revision first.
-	c == $$ ifTrue:[
-	    info := Class revisionInfoFromString:revision.
-	    info isNil ifTrue:[^ '0'].
-	    ^ (info revision) ? '0'.
-	].
-	c isDigit ifFalse:[
-	    ^ '0'
-	].
+        c := revision first.
+        c == $$ ifTrue:[
+            manager := self sourceCodeManagerFromBinaryRevision.
+            manager notNil ifTrue:[
+                info := manager revisionInfoFromString:revision.
+            ].
+            info isNil ifTrue:[^ '0'].
+            ^ (info revision) ? '0'.
+        ].
+        c isDigit ifFalse:[
+            ^ '0'
+        ].
     ].
 
     ^ revision
@@ -4262,13 +4337,14 @@
      |classes|
 
      classes := Smalltalk allClasses
-		    select:[:cls | cls binaryRevision notNil and:[cls binaryRevision ~= cls revision]].
+                    select:[:cls | cls binaryRevision notNil and:[cls binaryRevision ~= cls revision]].
      SystemBrowser browseClasses:classes title:'classes which are not up-to-date'
     "
 
     "Created: / 07-12-1995 / 10:58:47 / cg"
     "Modified: / 01-04-1997 / 23:33:01 / stefan"
     "Modified: / 22-10-2008 / 20:37:05 / cg"
+    "Modified: / 23-01-2012 / 19:38:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 binaryRevisionString
@@ -4324,11 +4400,11 @@
     |owner|
 
     (owner := self owningClass) notNil ifTrue:[^ owner findVersionMethod].
-    ^ self findVersionMethodOfManager:self sourceCodeManager
+    ^ self findVersionMethodOfManager:self sourceCodeManagerFromBinaryRevision
 
     "
      Smalltalk allClassesDo:[:cls |
-	Transcript show:cls name; show:' -> '; showCR:cls findVersionMethod
+        Transcript show:cls name; show:' -> '; showCR:cls findVersionMethod
      ].
 
      Number findVersionMethod
@@ -4338,6 +4414,7 @@
     "
 
     "Modified: / 19-04-2011 / 13:30:42 / cg"
+    "Modified: / 19-07-2013 / 22:11:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 findVersionMethodOfManager:aSourceCodemanagerOrNil
@@ -4798,7 +4875,7 @@
 	repositoryPath - the classes source container
     "
 
-    ^ self revisionInfoOfManager:self sourceCodeManager
+    ^ self revisionInfoOfManager:self sourceCodeManagerFromBinaryRevision
 
     "
      Object revisionString
@@ -5051,100 +5128,116 @@
     "/ or TryLocalSourceFirst is true,
     "/ look in standard places first
     "/
-    ((sourceCodeManager := self sourceCodeManager) isNil
-    or:[TryLocalSourceFirst == true]) ifTrue:[
-	sourceStream := self localSourceStreamFor:source.
+    "JV@2011-12-08: 
+        (i) first check TryLocalSourceFirst, this avoids useless call to
+            #sourceCodeManagerFromBinaryRevision when TryLocalSourceFirst is
+            set (for whatever reason)
+        (ii) do NOT ask source code manager during system startup - source code
+            managers are not configured anyway!! Also, avoids hangups during
+            startup when CVSROOT is set but server is unreacheable.
+    CAVEAT: When somebody modifies the code after compilation and methods
+        are recompiled during startup (for whatever reason), a bad code may
+        used, compilation may fail. However, it may happen anyway as SCM's
+        are not yet configured so the system may use wrong one. Moreover,
+        the source from which the class is compiled may not be the one in
+        repository. I (JV) think this is a good, less confusing compromise.
+    "
+    (TryLocalSourceFirst == true 
+        or:[Smalltalk isInitialized not
+            or: [(sourceCodeManager := self sourceCodeManagerFromBinaryRevision) isNil]])
+                ifTrue:[
+        sourceStream := self localSourceStreamFor:source.
+                ].
+
+    sourceStream isNil ifTrue:[
+        "/ mhmh - still no source file.
+        "/ If there is a SourceCodeManager, ask it to aquire the
+        "/ the source for my class, and return an open stream on it.
+        "/ if that one does not know about the source, look in
+        "/ standard places
+
+        sourceCodeManager notNil ifTrue:[
+            classFilename ~= source ifTrue:[
+                package notNil ifTrue:[
+                    sep := package indexOfAny:'/\:'.
+                    sep ~~ 0 ifTrue:[
+                        mod := package copyTo:sep - 1.
+                        dir := package copyFrom:sep + 1.
+                        sourceStream := sourceCodeManager streamForClass:nil fileName:source revision:(self binaryRevision) directory:dir module:mod cache:true.
+                    ]
+                ].
+            ].
+            sourceStream isNil ifTrue:[
+                classFilename isNil ifTrue:[
+                    guessedFileName := (Smalltalk fileNameForClass:self) , '.st'.
+                ].
+                source asFilename baseName = (classFilename ? guessedFileName) asFilename baseName ifTrue:[
+                    sourceStream := sourceCodeManager getSourceStreamFor:self.
+                ]
+            ].
+            sourceStream notNil ifTrue:[
+                (self validateSourceStream:sourceStream) ifFalse:[
+                    ('Class [info]: repositories source for "%1" is invalid.' bindWith:self theNonMetaclass name) errorPrintCR.
+                    sourceStream close.
+                    sourceStream := nil
+                ] ifTrue:[
+                    validated := true.
+                ].
+            ].
+        ]
     ].
 
     sourceStream isNil ifTrue:[
-	"/ mhmh - still no source file.
-	"/ If there is a SourceCodeManager, ask it to aquire the
-	"/ the source for my class, and return an open stream on it.
-	"/ if that one does not know about the source, look in
-	"/ standard places
-
-	sourceCodeManager notNil ifTrue:[
-	    classFilename ~= source ifTrue:[
-		package notNil ifTrue:[
-		    sep := package indexOfAny:'/\:'.
-		    sep ~~ 0 ifTrue:[
-			mod := package copyTo:sep - 1.
-			dir := package copyFrom:sep + 1.
-			sourceStream := sourceCodeManager streamForClass:nil fileName:source revision:(self binaryRevision) directory:dir module:mod cache:true.
-		    ]
-		].
-	    ].
-	    sourceStream isNil ifTrue:[
-		classFilename isNil ifTrue:[
-		    guessedFileName := (Smalltalk fileNameForClass:self) , '.st'.
-		].
-		source asFilename baseName = (classFilename ? guessedFileName) asFilename baseName ifTrue:[
-		    sourceStream := sourceCodeManager getSourceStreamFor:self.
-		]
-	    ].
-	    sourceStream notNil ifTrue:[
-		(self validateSourceStream:sourceStream) ifFalse:[
-		    ('Class [info]: repositories source for "%1" is invalid.' bindWith:self theNonMetaclass name) errorPrintCR.
-		    sourceStream close.
-		    sourceStream := nil
-		] ifTrue:[
-		    validated := true.
-		].
-	    ].
-	]
-    ].
-
-    sourceStream isNil ifTrue:[
-	"/
-	"/ hard case - there is no source file for this class
-	"/ (in the source-dir-path).
-	"/
-
-	"/
-	"/ look if my binary is from a dynamically loaded module,
-	"/ and, if so, look in the modules directory for the
-	"/ source file.
-	"/
-	ObjectFileLoader notNil ifTrue:[
-	    ObjectFileLoader loadedObjectHandlesDo:[:h |
-		|f classes|
-
-		sourceStream isNil ifTrue:[
-		    (classes := h classes) notEmptyOrNil ifTrue:[
-			(classes includes:self) ifTrue:[
-			    f := h pathName.
-			    f := f asFilename directory.
-			    f := f construct:source.
-			    f exists ifTrue:[
-				sourceStream := f readStreamOrNil.
-			    ].
-			].
-		    ].
-		]
-	    ].
-	].
+        "/
+        "/ hard case - there is no source file for this class
+        "/ (in the source-dir-path).
+        "/
+
+        "/
+        "/ look if my binary is from a dynamically loaded module,
+        "/ and, if so, look in the modules directory for the
+        "/ source file.
+        "/
+        ObjectFileLoader notNil ifTrue:[
+            ObjectFileLoader loadedObjectHandlesDo:[:h |
+                |f classes|
+
+                sourceStream isNil ifTrue:[
+                    (classes := h classes) notEmptyOrNil ifTrue:[
+                        (classes includes:self) ifTrue:[
+                            f := h pathName.
+                            f := f asFilename directory.
+                            f := f construct:source.
+                            f exists ifTrue:[
+                                sourceStream := f readStreamOrNil.
+                            ].
+                        ].
+                    ].
+                ]
+            ].
+        ].
     ].
 
     "/
     "/ try along sourcePath
     "/
     sourceStream isNil ifTrue:[
-	sourceStream := self localSourceStreamFor:source.
+        sourceStream := self localSourceStreamFor:source.
     ].
 
     "/
     "/ final chance: try current directory
     "/
     sourceStream isNil ifTrue:[
-	sourceStream := source asFilename readStreamOrNil.
+        sourceStream := source asFilename readStreamOrNil.
     ].
 
     (sourceStream notNil and:[validated not]) ifTrue:[
-	(self validateSourceStream:sourceStream) ifFalse:[
-	    ('Class [warning]: source for "%1" is invalid or stripped. Take care.' bindWith:self theNonMetaclass name) errorPrintCR.
-	    sourceStream close.
-	    sourceStream := nil
-	].
+        (self validateSourceStream:sourceStream) ifFalse:[
+            ('Class [warning]: source for "%1" is invalid or stripped. Take care.' bindWith:self theNonMetaclass name) errorPrintCR.
+            sourceStream close.
+            sourceStream := nil
+        ].
     ].
 "/    (sourceStream notNil and:[sourceStream isFileStream]) ifTrue:[
 "/        guessedFileName notNil ifTrue:[
@@ -5159,9 +5252,10 @@
      Autoload sourceStream
     "
 
-    "Created: / 10.11.1995 / 21:05:13 / cg"
-    "Modified: / 22.4.1998 / 19:20:50 / ca"
-    "Modified: / 5.11.2001 / 16:36:30 / cg"
+    "Created: / 10-11-1995 / 21:05:13 / cg"
+    "Modified: / 22-04-1998 / 19:20:50 / ca"
+    "Modified: / 05-11-2001 / 16:36:30 / cg"
+    "Modified: / 08-12-2011 / 19:16:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 updateVersionMethodFor:newRevisionString
@@ -5553,11 +5647,11 @@
 !Class class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.632 2013-11-21 15:02:57 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.633 2014-02-05 17:12:55 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.632 2013-11-21 15:02:57 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.633 2014-02-05 17:12:55 cg Exp $'
 !
 
 version_SVN