hg/stx-libbasic: comparison Class.st

equal deleted inserted replaced

-:45304252112b
+:edce1c1a0ab9
 the sourceCodemanager is always getting the source for the classes correct version.
 In contrast, the local file might be different from (edited in an external tool) in
 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"
 !
 tryLocalSourceFirst:aBoolean
 |lines line|
 lines := aMethodSourceString asCollectionOfLines.
 lines do:[:l |
-	|i|
+|i|
-	i := l indexOfSubCollection:'$Header: '.
+i := l indexOfSubCollection:'$Header: '.
-	"JV @ 2009-12-13: Also search for '$Id: ' (because of SVN-only classes)"
+"JV @ 2009-12-13: Also search for '$Id: ' (because of SVN-only classes)"
-	i == 0 ifTrue:[
+i == 0 ifTrue:[
-	i := l indexOfSubCollection:'$Id: '].
+i := l indexOfSubCollection:'$Id: '].
-	i ~~ 0 ifTrue:[
+"JV @ 2013-07-18: Also search for '$Changeset: ' (because of Mercurial-only classes)"
-	    line := l copyFrom:i.
+i == 0 ifTrue:[
-	    i := line lastIndexOf:$$.
+i := l indexOfSubCollection:'$Changeset: '].
-	    i > 1 ifTrue:[
-		line := line copyTo:i.
+i ~~ 0 ifTrue:[
-	    ].
+line := l copyFrom:i.
-	    ^ line
+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'!
 template:aCategoryString
 "Created: / 07-12-1995 / 13:16:46 / cg"
 "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"
 "/ use cached information (avoid class hierarchy search), if possible
 (subclasses isNil
 self withAllPrivateClassesDo:[:cls | coll add:cls].
 ^ coll
 "Created: / 18-07-2011 / 09:14:38 / cg"
 ! !
 !Class methodsFor:'adding & removing'!
 removeFromSystem
 "ST-80 compatibility
 !
 fileOutDefinitionOn:aStream
 "append an expression on aStream, which defines myself."
-^ self basicFileOutDefinitionOn:aStream withNameSpace:false
+^ self basicFileOutDefinitionOn:aStream withNameSpace:true
-"Modified: 4.1.1997 / 20:55:18 / cg"
+"Modified: / 04-01-1997 / 20:55:18 / cg"
+"Modified: / 04-02-2014 / 16:49:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 fileOutIn:aDirectoryName
 "create a file 'class.st' consisting of all methods in self in
 directory aDirectoryName (ignoring any directory setting in
 "return the revision-ID from which the class was stc-compiled;
 nil if its an autoloaded or filedIn class.
 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 := revision first.
-	c == $$ ifTrue:[
+c == $$ ifTrue:[
-	    info := Class revisionInfoFromString:revision.
+manager := self sourceCodeManagerFromBinaryRevision.
-	    info isNil ifTrue:[^ '0'].
+manager notNil ifTrue:[
-	    ^ (info revision) ? '0'.
+info := manager revisionInfoFromString:revision.
-	].
+].
-	c isDigit ifFalse:[
+info isNil ifTrue:[^ '0'].
-	    ^ '0'
+^ (info revision) ? '0'.
-	].
+].
+c isDigit ifFalse:[
+^ '0'
+].
 ].
 ^ revision
 "
 to find all classes which are not up-to-date:
 |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
 "return the revision-ID from which the class was stc-compiled;
 nil if its an autoloaded or filedIn class.
 or the fallBack (for backward compatibility)"
 |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
 FileDirectory findVersionMethod
 Metaclass findVersionMethod
 Class findVersionMethod
 "
 "Modified: / 19-04-2011 / 13:30:42 / cg"
+"Modified: / 19-07-2013 / 22:11:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 findVersionMethodOfManager:aSourceCodemanagerOrNil
 "{ Pragma: +optSpace }"
 	time           - the time when the logical revision was checked in
 	fileName       - the classes source file name
 	repositoryPath - the classes source container
 "
-^ self revisionInfoOfManager:self sourceCodeManager
+^ self revisionInfoOfManager:self sourceCodeManagerFromBinaryRevision
 "
 Object revisionString
 Object revisionInfo
 Image revisionInfo
 "/
 "/ if there is no SourceCodeManager,
 "/ or TryLocalSourceFirst is true,
 "/ look in standard places first
 "/
-((sourceCodeManager := self sourceCodeManager) isNil
+"JV@2011-12-08:
-or:[TryLocalSourceFirst == true]) ifTrue:[
+(i) first check TryLocalSourceFirst, this avoids useless call to
-	sourceStream := self localSourceStreamFor:source.
+#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.
+"/ mhmh - still no source file.
-	"/ If there is a SourceCodeManager, ask it to aquire the
+"/ If there is a SourceCodeManager, ask it to aquire the
-	"/ the source for my class, and return an open stream on it.
+"/ the source for my class, and return an open stream on it.
-	"/ if that one does not know about the source, look in
+"/ if that one does not know about the source, look in
-	"/ standard places
+"/ standard places
-	sourceCodeManager notNil ifTrue:[
+sourceCodeManager notNil ifTrue:[
-	    classFilename ~= source ifTrue:[
+classFilename ~= source ifTrue:[
-		package notNil ifTrue:[
+package notNil ifTrue:[
-		    sep := package indexOfAny:'/\:'.
+sep := package indexOfAny:'/\:'.
-		    sep ~~ 0 ifTrue:[
+sep ~~ 0 ifTrue:[
-			mod := package copyTo:sep - 1.
+mod := package copyTo:sep - 1.
-			dir := package copyFrom:sep + 1.
+dir := package copyFrom:sep + 1.
-			sourceStream := sourceCodeManager streamForClass:nil fileName:source revision:(self binaryRevision) directory:dir module:mod cache:true.
+sourceStream := sourceCodeManager streamForClass:nil fileName:source revision:(self binaryRevision) directory:dir module:mod cache:true.
-		    ]
+]
-		].
+].
-	    ].
+].
-	    sourceStream isNil ifTrue:[
+sourceStream isNil ifTrue:[
-		classFilename isNil ifTrue:[
+classFilename isNil ifTrue:[
-		    guessedFileName := (Smalltalk fileNameForClass:self) , '.st'.
+guessedFileName := (Smalltalk fileNameForClass:self) , '.st'.
-		].
+].
-		source asFilename baseName = (classFilename ? guessedFileName) asFilename baseName ifTrue:[
+source asFilename baseName = (classFilename ? guessedFileName) asFilename baseName ifTrue:[
-		    sourceStream := sourceCodeManager getSourceStreamFor:self.
+sourceStream := sourceCodeManager getSourceStreamFor:self.
-		]
+]
-	    ].
+].
-	    sourceStream notNil ifTrue:[
+sourceStream notNil ifTrue:[
-		(self validateSourceStream:sourceStream) ifFalse:[
+(self validateSourceStream:sourceStream) ifFalse:[
-		    ('Class [info]: repositories source for "%1" is invalid.' bindWith:self theNonMetaclass name) errorPrintCR.
+('Class [info]: repositories source for "%1" is invalid.' bindWith:self theNonMetaclass name) errorPrintCR.
-		    sourceStream close.
+sourceStream close.
-		    sourceStream := nil
+sourceStream := nil
-		] ifTrue:[
+] ifTrue:[
-		    validated := true.
+validated := true.
-		].
+].
-	    ].
+].
-	]
+]
 ].
 sourceStream isNil ifTrue:[
-	"/
+"/
-	"/ hard case - there is no source file for this class
+"/ hard case - there is no source file for this class
-	"/ (in the source-dir-path).
+"/ (in the source-dir-path).
-	"/
+"/
-	"/
+"/
-	"/ look if my binary is from a dynamically loaded module,
+"/ look if my binary is from a dynamically loaded module,
-	"/ and, if so, look in the modules directory for the
+"/ and, if so, look in the modules directory for the
-	"/ source file.
+"/ source file.
-	"/
+"/
-	ObjectFileLoader notNil ifTrue:[
+ObjectFileLoader notNil ifTrue:[
-	    ObjectFileLoader loadedObjectHandlesDo:[:h |
+ObjectFileLoader loadedObjectHandlesDo:[:h |
-		|f classes|
+|f classes|
-		sourceStream isNil ifTrue:[
+sourceStream isNil ifTrue:[
-		    (classes := h classes) notEmptyOrNil ifTrue:[
+(classes := h classes) notEmptyOrNil ifTrue:[
-			(classes includes:self) ifTrue:[
+(classes includes:self) ifTrue:[
-			    f := h pathName.
+f := h pathName.
-			    f := f asFilename directory.
+f := f asFilename directory.
-			    f := f construct:source.
+f := f construct:source.
-			    f exists ifTrue:[
+f exists ifTrue:[
-				sourceStream := f readStreamOrNil.
+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:[
+(self validateSourceStream:sourceStream) ifFalse:[
-	    ('Class [warning]: source for "%1" is invalid or stripped. Take care.' bindWith:self theNonMetaclass name) errorPrintCR.
+('Class [warning]: source for "%1" is invalid or stripped. Take care.' bindWith:self theNonMetaclass name) errorPrintCR.
-	    sourceStream close.
+sourceStream close.
-	    sourceStream := nil
+sourceStream := nil
-	].
+].
 ].
 "/    (sourceStream notNil and:[sourceStream isFileStream]) ifTrue:[
 "/        guessedFileName notNil ifTrue:[
 "/            self setClassFilename:(aStream pathName asFilename baseName).
 "/        ]
 Object sourceStream
 Clock sourceStream
 Autoload sourceStream
 "
-"Created: / 10.11.1995 / 21:05:13 / cg"
+"Created: / 10-11-1995 / 21:05:13 / cg"
-"Modified: / 22.4.1998 / 19:20:50 / ca"
+"Modified: / 22-04-1998 / 19:20:50 / ca"
-"Modified: / 5.11.2001 / 16:36:30 / cg"
+"Modified: / 05-11-2001 / 16:36:30 / cg"
+"Modified: / 08-12-2011 / 19:16:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 updateVersionMethodFor:newRevisionString
 "{ Pragma: +optSpace }"
 ! !
 !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
 ^ '$ Id: Class.st 10643 2011-06-08 21:53:07Z vranyj1  $'
 ! !

changeset 15947	edce1c1a0ab9
parent 15821	5ba671bedf2e
child 16020	fa71b75a7550