hg/stx-libbasic: comparison Class.st

equal deleted inserted replaced

-:9c19c2b9e8c0
+:94acb9d1afc8
 The classes are sorted by inheritance."
 |classes pivateClassesOf|
 classes := self privateClasses.
-(classes size > 0) ifTrue:[
+classes notEmpty ifTrue:[
-	classes := classes asOrderedCollection.
+classes := classes asOrderedCollection.
-	classes sort:[:a :b | a name < b name].
+classes sort:[:a :b | a name < b name].
-	pivateClassesOf := IdentityDictionary new.
+pivateClassesOf := IdentityDictionary new.
-	classes do:[:each | pivateClassesOf at:each put:(each allPrivateClasses)].
+classes do:[:each | pivateClassesOf at:each put:(each allPrivateClasses)].
-	classes topologicalSort:[:a :b |
+classes topologicalSort:[:a :b |
-	    "/ a must come before b iff:
+"/ a must come before b iff:
-	    "/    b is a subclass of a
+"/    b is a subclass of a
-	    "/    b has a private class which is a subclass of a
+"/    b has a private class which is a subclass of a
-	    |mustComeBefore pivateClassesOfB|
+|mustComeBefore pivateClassesOfB|
-	    mustComeBefore := b isSubclassOf:a.
+mustComeBefore := b isSubclassOf:a.
-	    pivateClassesOfB := pivateClassesOf at:b.
+pivateClassesOfB := pivateClassesOf at:b.
-	    pivateClassesOfB do:[:eachClassInB |
+pivateClassesOfB do:[:eachClassInB |
-		mustComeBefore := mustComeBefore or:[eachClassInB isSubclassOf:a]
+mustComeBefore := mustComeBefore or:[eachClassInB isSubclassOf:a]
-	    ].
+].
-	    mustComeBefore
+mustComeBefore
-	].
+].
 ].
 ^ classes.
 "
 Object privateClassesSorted
-NewSystemBrowser privateClassesSorted
+Class privateClassesSorted
-NewSystemBrowser privateClasses
+Class privateClasses
 "
 "Created: 22.3.1997 / 16:10:42 / cg"
 "Modified: 22.3.1997 / 16:11:20 / cg"
 !
 aStream nextPutLine:'</indexed-type>'.
 aStream nextPutAll:'  <inst-vars>'.
 varNames := self instVarNames.
 varNames size > 0 ifTrue:[
-	aStream cr.
+aStream cr.
-	varNames do:[:nm |
+varNames do:[:nm |
-	    aStream nextPutAll:'    <name>'.
+aStream nextPutAll:'    <name>'.
-	    aStream nextPutAll:nm.
+aStream nextPutAll:nm.
-	    aStream nextPutLine:'</name>'.
+aStream nextPutLine:'</name>'.
-	].
+].
-	aStream nextPutAll:'  '.
+aStream nextPutAll:'  '.
 ].
 aStream nextPutLine:'</inst-vars>'.
 aStream nextPutAll:'  <class-inst-vars>'.
 varNames := self class instVarNames.
 varNames size > 0 ifTrue:[
-	aStream cr.
+aStream cr.
-	varNames do:[:nm |
+varNames do:[:nm |
-	    aStream nextPutAll:'    <name>'.
+aStream nextPutAll:'    <name>'.
-	    aStream nextPutAll:nm.
+aStream nextPutAll:nm.
-	    aStream nextPutLine:'</name>'.
+aStream nextPutLine:'</name>'.
-	].
+].
-	aStream nextPutAll:'  '.
+aStream nextPutAll:'  '.
 ].
 aStream nextPutLine:'</class-inst-vars>'.
 aStream nextPutAll:'  <imports>'.
 aStream nextPutAll:''.
 aStream nextPutAll:self category.
 aStream nextPutLine:'</category>'.
 aStream nextPutLine:'</class>'.
-varNames := self classVarNames.
+self classVarNames do:[:nm |
-varNames size > 0 ifTrue:[
+aStream nextPutLine:'<static>'.
-	varNames do:[:nm |
+aStream nextPutAll:' <name>'.
-	    aStream nextPutLine:'<static>'.
+aStream nextPutAll:nm.
-	    aStream nextPutAll:' <name>'.
+aStream nextPutLine:'</name>'.
-	    aStream nextPutAll:nm.
+aStream nextPutAll:' <environment>'.
-	    aStream nextPutLine:'</name>'.
+aStream nextPutAll:self name.
-	    aStream nextPutAll:' <environment>'.
+aStream nextPutLine:'</environment>'.
-	    aStream nextPutAll:self name.
+aStream nextPutLine:'</static>'.
-	    aStream nextPutLine:'</environment>'.
-	    aStream nextPutLine:'</static>'.
-	].
 ].
 !
 fileOutXMLOn:aStream
 "WARNING: untested first version. Not for general use (yet)
 "{ Pragma: +optSpace }"
 "append a category change record to aStream"
 self printClassNameOn:aStream.
-aStream nextPutAll:(' category:' , category storeString).
+aStream nextPutAll:' category:'.
+category storeOn:aStream.
 aStream nextPutChunkSeparator.
 "Created: 3.12.1995 / 13:43:33 / cg"
 "Modified: 3.12.1995 / 14:10:34 / cg"
 !
 addChangeRecordForClassRemove:oldClass to:aStream
 "{ Pragma: +optSpace }"
 "append a class-remove-record to aStream"
-aStream nextPutAll:('Smalltalk removeClass:' , oldClass name).
+aStream
-aStream nextPutChunkSeparator.
+nextPutAll:'Smalltalk removeClass:';
+nextPutAll:oldClass name;
+nextPutChunkSeparator.
 !
 addChangeRecordForClassRename:oldName to:newName to:aStream
 "{ Pragma: +optSpace }"
 "append a class-rename-record to aStream"
-aStream nextPutAll:('Smalltalk renameClass:' , oldName, ' to:''' , newName , '''').
+aStream
-aStream nextPutChunkSeparator.
+nextPutAll:'Smalltalk renameClass:';
+nextPutAll:oldName
+nextPutAll:' to:'''
+nextPutAll:newName
+nextPutAll:'''';
+nextPutChunkSeparator.
 "Modified: 30.10.1996 / 20:27:02 / cg"
 !
 addChangeRecordForPrimitiveDefinitions:aClass to:aStream
 into the sourceCode repository. (extensions are stored separate)"
 |clsPkg|
 clsPkg := self package.
-aPackageID = clsPkg ifTrue:[^ #()].
+aPackageID = clsPkg ifTrue:[^ false].
 self instAndClassMethodsDo:[:mthd |
-	mthd package = aPackageID ifTrue:[ ^ true].
+mthd package = aPackageID ifTrue:[ ^ true].
 ].
 ^ false
 "
 Smalltalk allClasses
-	select:[:each | each hasExtensionsFrom:'stx:goodies/refactyBrowser']
+select:[:each | each hasExtensionsFrom:'stx:goodies/refactyBrowser']
 Smalltalk allClasses
-	select:[:each | each hasExtensionsFrom:'stx:libboss']
+select:[:each | each hasExtensionsFrom:'stx:libboss']
 "
 "Modified: / 06-03-2007 / 11:55:39 / cg"
 !
 tryVersionFromVersionMethod|
 (owner := self owningClass) notNil ifTrue:[^ owner findVersionMethodOfManager:aSourceCodemanagerOrNil].
 tryVersionFromVersionMethod :=
-	[:versionMethodsName |
+[:versionMethodsName |
-	    |aVersionMethod val|
+|aVersionMethod val|
-	    aVersionMethod := meta compiledMethodAt:versionMethodsName.
+aVersionMethod := meta compiledMethodAt:versionMethodsName.
-	    (aVersionMethod notNil and:[aVersionMethod isExecutable]) ifTrue:[
+(aVersionMethod notNil and:[aVersionMethod isExecutable]) ifTrue:[
-		"/
+"/
-		"/ if it's a method returning the version string,
+"/ if it's a method returning the version string,
-		"/ that's the returned value
+"/ that's the returned value
-		"/
+"/
-		val := cls perform:versionMethodsName.
+val := cls perform:versionMethodsName.
-		val isString ifTrue:[^ aVersionMethod].
+val isString ifTrue:[^ aVersionMethod].
-	    ].
+].
-	].
+].
 meta := self theMetaclass.
 cls := self theNonMetaclass.
 allVersionMethodNames := meta methodDictionary keys select:[:sel | sel startsWith:AbstractSourceCodeManager prefixOfVersionMethodSelector].
 aSourceCodemanagerOrNil notNil ifTrue:[
-	nameOfVersionMethodForManager := aSourceCodemanagerOrNil nameOfVersionMethodInClasses.
+nameOfVersionMethodForManager := aSourceCodemanagerOrNil nameOfVersionMethodInClasses.
-	(allVersionMethodNames includes:nameOfVersionMethodForManager) ifTrue:[
+(allVersionMethodNames includes:nameOfVersionMethodForManager) ifTrue:[
-	    tryVersionFromVersionMethod value:nameOfVersionMethodForManager
+tryVersionFromVersionMethod value:nameOfVersionMethodForManager
-	].
+].
-	"/ only trust the oldVersion method, iff there is no other scv-version
+"/ only trust the oldVersion method, iff there is no other scv-version
-	"/ (i.e. do not misuse an svn-checked-in #version as a version_cvs)
+"/ (i.e. do not misuse an svn-checked-in #version as a version_cvs)
-	(allVersionMethodNames copyWithout:nameOfVersionMethodForManager) size > 0 ifTrue:[
+(allVersionMethodNames copyWithout:nameOfVersionMethodForManager) notEmpty ifTrue:[
-	    ^ nil
+^ nil
-	].
+].
 ].
 nameOfOldVersionMethod := self nameOfOldVersionMethod.
 tryVersionFromVersionMethod value:nameOfOldVersionMethod.
 ^ nil.
 "
 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
 the directory info defaults to library name.
 The library name may not be left blank.
 (this is done for backward compatibility,)
 For example:
-	'....(libbasic)'                         -> module: stx directory: libbasic library: libbasic
+'....(libbasic)'                         -> module: stx directory: libbasic library: libbasic
-	'....(stx:libbasic)'                     -> module: stx directory: libbasic library: libbasic
+'....(stx:libbasic)'                     -> module: stx directory: libbasic library: libbasic
-	'....(stx:foo:libbfoo)'                  -> module: stx directory: foo library: libfoo
+'....(stx:foo:libbfoo)'                  -> module: stx directory: foo library: libfoo
-	'....(aeg:libIECInterface)'              -> module: aeg directory: libIECInterface library:libIECInterface
+'....(aeg:libIECInterface)'              -> module: aeg directory: libIECInterface library:libIECInterface
-	'....(stx:goodies/persistency:libdbase)' -> module: stx directory: goodies/persistency library:libdbase
+'....(stx:goodies/persistency:libdbase)' -> module: stx directory: goodies/persistency library:libdbase
 The way how the sourceCodeManager uses this to find the source location
 depends on the scheme used. For CVS, the module is taken as the -d arg,
 while the directory is prepended to the file name.
 Other schemes may do things differently - these are not yet specified.
 Caveat:
-	Encoding this info in the package string seems somewhat kludgy.
+Encoding this info in the package string seems somewhat kludgy.
 "
 |owner sourceInfo packageString idx1 idx2
 moduleString directoryString libraryString components component1 component2 dirComponents mgr|
 package == (PackageId noProjectID) ifTrue:[^ nil].
 packageString := package asString.
 idx1 := packageString lastIndexOf:$(.
 idx1 ~~ 0 ifTrue:[
-	idx2 := packageString indexOf:$) startingAt:idx1+1.
+idx2 := packageString indexOf:$) startingAt:idx1+1.
-	idx2 ~~ 0 ifTrue:[
+idx2 ~~ 0 ifTrue:[
-	    sourceInfo := packageString copyFrom:idx1 + 1 to:idx2 - 1
+sourceInfo := packageString copyFrom:idx1 + 1 to:idx2 - 1
-	]
+]
 ] ifFalse:[
-	sourceInfo := packageString
+sourceInfo := packageString
 ].
 sourceInfo isNil ifTrue:[^ nil].
 components := sourceInfo asCollectionOfSubstringsSeparatedBy:$:.
-components size == 0 ifTrue:[
+components notEmpty ifTrue:[
 "/        moduleString := 'stx'.
 "/        directoryString := libraryString := ''.
-	^ nil
+^ nil
 ].
 component1 := components at:1.
 components size == 1 ifTrue:[
-	"/ a single name given - the module becomes 'stx' or
+"/ a single name given - the module becomes 'stx' or
-	"/ the very first directory component (if such a module exists).
+"/ the very first directory component (if such a module exists).
-	"/ If the component includes slashes, its the directory
+"/ If the component includes slashes, its the directory
-	"/ otherwise the library.
+"/ otherwise the library.
-	"/
+"/
-	dirComponents := Filename components:component1.
+dirComponents := Filename components:component1.
-	(dirComponents size > 1
+(dirComponents size > 1
-	and:[(mgr := self sourceCodeManager) notNil
+and:[(mgr := self sourceCodeManager) notNil
-	and:[mgr checkForExistingModule:dirComponents first]]) ifTrue:[
+and:[mgr checkForExistingModule:dirComponents first]]) ifTrue:[
-	    moduleString := dirComponents first.
+moduleString := dirComponents first.
-	    directoryString := libraryString := (Filename fromComponents:(dirComponents copyFrom:2)) asString.
+directoryString := libraryString := (Filename fromComponents:(dirComponents copyFrom:2)) asString.
-	] ifFalse:[
+] ifFalse:[
-	    "/ non-existing; assume directory under the stx package.
+"/ non-existing; assume directory under the stx package.
-	    moduleString := 'stx'.
+moduleString := 'stx'.
-	    (component1 startsWith:'stx/') ifTrue:[
+(component1 startsWith:'stx/') ifTrue:[
-		component1 := component1 copyFrom:5
+component1 := component1 copyFrom:5
-	    ].
+].
-	    directoryString := libraryString := component1.
+directoryString := libraryString := component1.
-	].
+].
-	(libraryString includes:$/) ifTrue:[
+(libraryString includes:$/) ifTrue:[
-	    libraryString := libraryString asFilename baseName
+libraryString := libraryString asFilename baseName
-	]
+]
 ] ifFalse:[
-	component2 := components at:2.
+moduleString := component1.
-	components size == 2 ifTrue:[
+component2 := components at:2.
-	    "/ two components - assume its the module and the directory;
+directoryString := component2.
-	    "/ the library is assumed to be named after the directory
+components size == 2 ifTrue:[
-	    "/ except, if slashes are in the name; then the libraryname
+"/ two components - assume its the module and the directory;
-	    "/ is the last component.
+"/ the library is assumed to be named after the directory
-	    "/
+"/ except, if slashes are in the name; then the libraryname
-	    moduleString := component1.
+"/ is the last component.
-	    directoryString := libraryString := component2.
+"/
-	    (libraryString includes:$/) ifTrue:[
+libraryString := component2.
-		libraryString := libraryString asFilename baseName
+(libraryString includes:$/) ifTrue:[
-	    ]
+libraryString := libraryString asFilename baseName
-	] ifFalse:[
+]
-	    "/ all components given
+] ifFalse:[
-	    moduleString := component1.
+"/ all components given
-	    directoryString := component2.
+libraryString := components at:3.
-	    libraryString := components at:3.
+]
-	]
 ].
 libraryString isEmpty ifTrue:[
-	directoryString notEmpty ifTrue:[
+directoryString notEmpty ifTrue:[
-	    libraryString := directoryString asFilename baseName
+libraryString := directoryString asFilename baseName
-	].
+].
-	libraryString isEmpty ifTrue:[
+libraryString isEmpty ifTrue:[
-	    "/ lets extract the library from the liblist file ...
+"/ lets extract the library from the liblist file ...
-	    libraryString := Smalltalk libraryFileNameOfClass:self.
+libraryString := Smalltalk libraryFileNameOfClass:self.
-	    libraryString isNil ifTrue:[^ nil].
+libraryString isNil ifTrue:[^ nil].
-	]
+]
 ].
 moduleString isEmpty ifTrue:[
-	moduleString := 'stx'.
+moduleString := 'stx'.
 ].
 directoryString isEmpty ifTrue:[
-	directoryString := libraryString.
+directoryString := libraryString.
 ].
 ^ IdentityDictionary
-	with:(#module->moduleString)
+with:(#module->moduleString)
-	with:(#directory->directoryString)
+with:(#directory->directoryString)
-	with:(#library->libraryString)
+with:(#library->libraryString)
 "
 Object packageSourceCodeInfo
 View packageSourceCodeInfo
 Model packageSourceCodeInfo
 "/ or TryLocalSourceFirst is true,
 "/ look in standard places first
 "/
 ((sourceCodeManager := self sourceCodeManager) isNil
 or:[TryLocalSourceFirst == true]) ifTrue:[
-	sourceStream := self localSourceStreamFor:source.
+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:[
-		sep := self package indexOfAny:'/\:'.
+sep := self 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.
 self breakPoint:#fm.
-		    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) size > 0 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).
 "/        ]
 ! !
 !Class class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.602 2012-02-07 16:41:55 cg Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.603 2012-05-26 20:02:59 stefan Exp $'
 !
 version_CVS
-^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.602 2012-02-07 16:41:55 cg Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.603 2012-05-26 20:02:59 stefan Exp $'
 !
 version_SVN
 ^ '� Id: Class.st 10643 2011-06-08 21:53:07Z vranyj1  �'
 ! !

changeset 14146	94acb9d1afc8
parent 14000	1b4fbb92d572
child 14147	ba9cc1cb4e0a