hg/stx-libbasic: comparison Class.st

equal deleted inserted replaced

-:4f37ae9c8961
+:b6bde90005a8
 Class adds more functionality to classes; minimum stuff has already
 been defined in Behavior and ClassDescription; this adds naming, categories etc.
 [Instance variables:]
-name            <Symbol>        the classes name
+	name            <Symbol>        the classes name
-category        <Symbol>        the classes category
+	category        <Symbol>        the classes category
-classvars       <String>        the names of the class variables
+	classvars       <String>        the names of the class variables
-comment         <String>        the classes comment; either a string,
+	comment         <String>        the classes comment; either a string,
-a number specifying the offset in classFilename, or nil
+					a number specifying the offset in classFilename, or nil
-subclasses      <Collection>    cached collection of subclasses
+	subclasses      <Collection>    cached collection of subclasses
-(currently unused - but will be soon)
+					(currently unused - but will be soon)
-classFilename   <String>        the file (or nil) where the classes
+	classFilename   <String>        the file (or nil) where the classes
-sources are found
+					sources are found
-package         <Symbol>        the package, in which the class was defined
+	package         <Symbol>        the package, in which the class was defined
-(inserted by compilers)
+					(inserted by compilers)
-revision        <String>        revision string - inserted by stc
+	revision        <String>        revision string - inserted by stc
-primitiveSpec   <Array | nil>   describes primitiveIncludes, primitiveFunctions etc.
+	primitiveSpec   <Array | nil>   describes primitiveIncludes, primitiveFunctions etc.
-environment     <Symbol | nil>  cached environment (i.e. Smalltalk or a namespace)
+	environment     <Symbol | nil>  cached environment (i.e. Smalltalk or a namespace)
-of class
+					of class
-signature       <SmallInteger>  the classes signature (used to detect obsolete
+	signature       <SmallInteger>  the classes signature (used to detect obsolete
-or changed classes with binaryStorage)
+					or changed classes with binaryStorage)
-This is filled in lazy - i.e. upon the first signature query.
+					This is filled in lazy - i.e. upon the first signature query.
-hook            <any>           reserved: a place to add additional attributes,
+	hook            <any>           reserved: a place to add additional attributes,
-without a need to recompile all classes.
+					without a need to recompile all classes.
-Currently unused.
+					Currently unused.
 [Class variables:]
-OldMethods                      if nonNil, this must be an IdentityDictionary,
+	OldMethods                      if nonNil, this must be an IdentityDictionary,
-which is filled with method->previousversionMethod
+					which is filled with method->previousversionMethod
-associations. Can be used for undo-last-method-change
+					associations. Can be used for undo-last-method-change
-Notice: this may fillup your memory over time.
+					Notice: this may fillup your memory over time.
 WARNING: layout known by compiler and runtime system
 [author:]
-Claus Gittinger
+	Claus Gittinger
 [see also:]
-Behavior ClassDescription Metaclass
+	Behavior ClassDescription Metaclass
 "
 ! !
 !Class class methodsFor:'Signal constants'!
 keepMethodHistory:aBoolean
 "turn on/off oldMethod remembering. If on, a methods previous version
 is kept locally, for later undo (or compare)."
 aBoolean ifTrue:[
-OldMethods isNil ifTrue:[
+	OldMethods isNil ifTrue:[
-OldMethods := IdentityDictionary new.
+	    OldMethods := IdentityDictionary new.
-]
+	]
 ] ifFalse:[
-OldMethods := nil
+	OldMethods := nil
 ].
 "
 Class keepMethodHistory:true
 Class keepMethodHistory:false
 flushMethodHistory
 "flush any method->previousVersion associations,
 all history is lost."
 OldMethods notNil ifTrue:[
-OldMethods := IdentityDictionary new
+	OldMethods := IdentityDictionary new
 ].
 "Created: 7.11.1996 / 19:07:25 / cg"
 !
 "/
 "/ mhmh - ask the default manager
 "/
 (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
-info := mgr revisionInfoFromString:aString.
+	info := mgr revisionInfoFromString:aString.
-info notNil ifTrue:[
+	info notNil ifTrue:[
-^ info
+	    ^ info
-]
+	]
 ].
 "/
 "/ fallBack - handles some RCS headers only
 "/ is this really needed ?
 "/
 info := IdentityDictionary new.
 words := aString asCollectionOfWords.
 words notEmpty ifTrue:[
-"/
+	"/
-"/ supported formats:
+	"/ supported formats:
-"/
+	"/
-"/ $-Header: pathName rev date time user state $
+	"/ $-Header: pathName rev date time user state $
-"/ $-Revision: rev $
+	"/ $-Revision: rev $
-"/ $-Id: fileName rev date time user state $
+	"/ $-Id: fileName rev date time user state $
-"/
+	"/
-((words at:1) = '$Header:') ifTrue:[
+	((words at:1) = '$Header:') ifTrue:[
-nm := words at:2.
+	    nm := words at:2.
-info at:#repositoryPathName put:nm.
+	    info at:#repositoryPathName put:nm.
-(nm endsWith:',v') ifTrue:[
+	    (nm endsWith:',v') ifTrue:[
-nm := nm copyWithoutLast:2
+		nm := nm copyWithoutLast:2
-].
+	    ].
-info at:#fileName put:nm asFilename baseName.
+	    info at:#fileName put:nm asFilename baseName.
-words size > 2 ifTrue:[
+	    words size > 2 ifTrue:[
-(words at:3) = '$' ifFalse:[
+		(words at:3) = '$' ifFalse:[
-info at:#revision put:(words at:3).
+		    info at:#revision put:(words at:3).
-(words at:4) = '$' ifFalse:[
+		    (words at:4) = '$' ifFalse:[
-info at:#date put:(words at:4).
+			info at:#date put:(words at:4).
-info at:#time put:(words at:5).
+			info at:#time put:(words at:5).
-info at:#user put:(words at:6).
+			info at:#user put:(words at:6).
-info at:#state put:(words at:7).
+			info at:#state put:(words at:7).
-]
+		    ]
-].
+		].
-].
+	    ].
-^ info
+	    ^ info
-].
+	].
-((words at:1) = '$Revision:') ifTrue:[
+	((words at:1) = '$Revision:') ifTrue:[
-info at:#revision put:(words at:2).
+	    info at:#revision put:(words at:2).
-^ info
+	    ^ info
-].
+	].
-((words at:1) = '$Id:') ifTrue:[
+	((words at:1) = '$Id:') ifTrue:[
-info at:#fileName put:(words at:2).
+	    info at:#fileName put:(words at:2).
-info at:#revision put:(words at:3).
+	    info at:#revision put:(words at:3).
-info at:#date put:(words at:4).
+	    info at:#date put:(words at:4).
-info at:#time put:(words at:5).
+	    info at:#time put:(words at:5).
-info at:#user put:(words at:6).
+	    info at:#user put:(words at:6).
-info at:#state put:(words at:7).
+	    info at:#state put:(words at:7).
-^ info
+	    ^ info
-].
+	].
 ].
 ^ nil
 "Created: 15.11.1995 / 14:58:35 / cg"
 |lines line|
 lines := aMethodSourceString asCollectionOfLines.
 lines do:[:l |
-|i|
+	|i|
-i := l indexOfSubCollection:'$Header: '.
+	i := l indexOfSubCollection:'$Header: '.
-i ~~ 0 ifTrue:[
+	i ~~ 0 ifTrue:[
-line := l copyFrom:i.
+	    line := l copyFrom:i.
-i := line lastIndexOf:$$.
+	    i := line lastIndexOf:$$.
-i > 1 ifTrue:[
+	    i > 1 ifTrue:[
-line := line copyTo:i.
+		line := line copyTo:i.
-].
+	    ].
-^ line
+	    ^ line
-]
+	]
 ].
 ^ nil
 "Created: 15.10.1996 / 18:57:57 / cg"
 "Modified: 16.10.1996 / 16:54:40 / cg"
 "this method allows fileIn of ST/V classes
 (which seem to have no category)"
 ^ self subclass:t
-instanceVariableNames:f
+	   instanceVariableNames:f
-classVariableNames:d
+	   classVariableNames:d
-poolDictionaries:s
+	   poolDictionaries:s
-category:'ST/V classes'
+	   category:'ST/V classes'
 "Modified: 5.1.1997 / 19:59:30 / cg"
 !
 variableByteSubclass:t classVariableNames:d poolDictionaries:s
 "this method allows fileIn of ST/V variable byte classes
 (which seem to have no category and no instvars)"
 ^ self variableByteSubclass:t
-instanceVariableNames:''
+	   instanceVariableNames:''
-classVariableNames:d
+	   classVariableNames:d
-poolDictionaries:s
+	   poolDictionaries:s
-category:'ST/V classes'
+	   category:'ST/V classes'
 "Modified: 5.1.1997 / 19:59:33 / cg"
 !
 variableSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s
 "this method allows fileIn of ST/V variable pointer classes
 (which seem to have no category)"
 ^ self variableSubclass:t
-instanceVariableNames:f
+	   instanceVariableNames:f
-classVariableNames:d
+	   classVariableNames:d
-poolDictionaries:s
+	   poolDictionaries:s
-category:'ST/V classes'
+	   category:'ST/V classes'
 "Modified: 5.1.1997 / 19:59:36 / cg"
 ! !
 !Class methodsFor:'ST80 compatibility'!
 |d|
 d := IdentityDictionary new.
 self classVarNames do:[:nm |
-|sym|
+	|sym|
-sym := nm asSymbol.
+	sym := nm asSymbol.
-d at:sym put:(self classVarAt:sym)
+	d at:sym put:(self classVarAt:sym)
 ].
 ^ d
 "
 Button classPool
 No change record is written and no classes are recompiled."
 |prevVarNames varNames any|
 (classvars = aString) ifFalse:[
-prevVarNames := self classVarNames.
+	prevVarNames := self classVarNames.
-classvars := aString.
+	classvars := aString.
-varNames := self classVarNames.
+	varNames := self classVarNames.
-"new ones get initialized to nil;
+	"new ones get initialized to nil;
-- old ones are nilled and removed from Smalltalk"
+	 - old ones are nilled and removed from Smalltalk"
-any := false.
+	any := false.
-varNames do:[:aName |
+	varNames do:[:aName |
-(prevVarNames includes:aName) ifFalse:[
+	    (prevVarNames includes:aName) ifFalse:[
-"a new one"
+		"a new one"
-self classVarAt:aName put:nil.
+		self classVarAt:aName put:nil.
-any := true.
+		any := true.
-] ifTrue:[
+	    ] ifTrue:[
-prevVarNames remove:aName
+		prevVarNames remove:aName
-]
+	    ]
-].
+	].
-"left overs are gone"
+	"left overs are gone"
-prevVarNames do:[:aName |
+	prevVarNames do:[:aName |
-self classVarAt:aName put:nil.
+	    self classVarAt:aName put:nil.
-Smalltalk removeKey:(self name , ':' , aName) asSymbol.
+	    Smalltalk removeKey:(self name , ':' , aName) asSymbol.
-].
+	].
-any ifTrue:[
+	any ifTrue:[
-Smalltalk changed:#classVariables with:self
+	    Smalltalk changed:#classVariables with:self
-].
+	].
 ]
 "Modified: 2.4.1997 / 00:16:05 / stefan"
 !
 "/ due to the implementation, extract this from my name
 "/ (physically, all classes are found in Smalltalk)
 idx := name lastIndexOf:$:.
 idx == 0 ifTrue:[
-environment := Smalltalk.
+	environment := Smalltalk.
-^ Smalltalk
+	^ Smalltalk
 ].
 (name at:idx-1) ~~ $: ifTrue:[
-environment := Smalltalk.
+	environment := Smalltalk.
-^ Smalltalk
+	^ Smalltalk
 ].
 nsName := name copyTo:(idx - 2).
 environment := Smalltalk at:nsName asSymbol.
 ^ environment
 "Modified: 24.3.1997 / 11:12:09 / cg"
 !
 package
-"return the package of the class"
+"return the package-id of the class"
 |owner|
 (owner := self owningClass) notNil ifTrue:[^ owner package].
 ^ package
 classes := IdentitySet new.
 myName := self name.
 myNamePrefix := myName , '::'.
 Smalltalk allBehaviorsDo:[:aClass |
-|nm owner|
+	|nm owner|
-aClass isBehavior ifTrue:[
+	aClass isBehavior ifTrue:[
-(owner := aClass owningClass) notNil ifTrue:[
+	    (owner := aClass owningClass) notNil ifTrue:[
 "/                owner == self ifTrue:[
 "/                    classes add:aClass.
 "/                ].
-nm := aClass name.
+		nm := aClass name.
-(nm startsWith:myNamePrefix) ifTrue:[
+		(nm startsWith:myNamePrefix) ifTrue:[
-"/ care for private-privateClasses
+		    "/ care for private-privateClasses
-(nm indexOf:$: startingAt:myName size + 3) == 0 ifTrue:[
+		    (nm indexOf:$: startingAt:myName size + 3) == 0 ifTrue:[
-classes add:aClass.
+			classes add:aClass.
-]
+		    ]
-]
+		]
-]
+	    ]
-]
+	]
 ].
 ^ classes asSortedCollection:[:a :b | a name < b name].
 "
 Object privateClasses
 |nmSym|
 nmSym := (self name , '::' , aClassNameStringOrSymbol) asSymbolIfInterned.
 nmSym isNil ifTrue:[
-"/ no such symbol - there cannot be a corresponding private class
+	"/ no such symbol - there cannot be a corresponding private class
-^ nil
+	^ nil
 ].
 ^ Smalltalk at:nmSym.
 "Modified: 26.6.1997 / 11:44:04 / cg"
 |classes|
 classes := self privateClasses.
 (classes notNil and:[classes notEmpty]) ifTrue:[
-classes := classes asOrderedCollection topologicalSort:[:a :b | b isSubclassOf:a].
+	classes := classes asOrderedCollection topologicalSort:[:a :b | b isSubclassOf:a].
 ].
 ^ classes.
 "
 Object privateClassesSorted
 is gone ...)"
 |nm|
 self wasAutoloaded ifFalse:[
-"
+	"
-can it be done ?
+	 can it be done ?
-(all of my methods must have a source)
+	 (all of my methods must have a source)
-"
+	"
-self methodDictionary do:[:aMethod |
+	self methodDictionary do:[:aMethod |
-aMethod source isNil ifTrue:[^false].
+	    aMethod source isNil ifTrue:[^false].
-aMethod hasPrimitiveCode ifTrue:[^ false].
+	    aMethod hasPrimitiveCode ifTrue:[^ false].
-].
+	].
-self class methodDictionary do:[:aMethod |
+	self class methodDictionary do:[:aMethod |
-aMethod source isNil ifTrue:[^false].
+	    aMethod source isNil ifTrue:[^false].
-aMethod hasPrimitiveCode ifTrue:[^ false].
+	    aMethod hasPrimitiveCode ifTrue:[^ false].
-].
+	].
 ].
 self allSubclassesDo:[:aClass |
-aClass unload
+	aClass unload
 ].
 Transcript showCR:'unloading ' , name , ' ...'.
 Autoload removeClass:self.
 nm := name.
 !Class methodsFor:'binary storage'!
 addGlobalsForBinaryStorageTo:globalDictionary
 "
 classPool == nil ifFalse: [
-classPool associationsDo: [:assoc|
+	classPool associationsDo: [:assoc|
-globalDictionary at: assoc put: self
+	    globalDictionary at: assoc put: self
-]
+	]
 ]
 "
 "Created: 21.3.1997 / 15:40:45 / cg"
 !
 "/   number of private classes
 "/   private classes, if any
 formatID := manager nextObject.
 formatID isInteger ifFalse:[       "/ backward compatibilty
-formatID := nil.
+	formatID := nil.
-superclassName := formatID
+	superclassName := formatID
 ] ifTrue:[
-superclassName := manager nextObject.
+	superclassName := manager nextObject.
 ].
 superclassSig := manager nextObject.
 superclassName notNil ifTrue:[
-superClass := Smalltalk at:superclassName ifAbsent:nil.
+	superClass := Smalltalk at:superclassName ifAbsent:nil.
-superClass isNil ifTrue:[
+	superClass isNil ifTrue:[
-BinaryIOManager nonexistingClassSignal
+	    BinaryIOManager nonexistingClassSignal
-raiseRequestWith:'non existent superclass (in binaryLoad)'.
+		raiseRequestWith:'non existent superclass (in binaryLoad)'.
-^ nil
+	    ^ nil
-].
+	].
-"/ ('loading superclass: ' ,  superclassName ) printNL.
+	"/ ('loading superclass: ' ,  superclassName ) printNL.
-superClass autoload.
+	superClass autoload.
-superClass := Smalltalk at:superclassName.
+	superClass := Smalltalk at:superclassName.
-superclassSig ~= superClass signature ifTrue:[
+	superclassSig ~= superClass signature ifTrue:[
-BinaryIOManager changedInstLayoutSignal
+	    BinaryIOManager changedInstLayoutSignal
-raiseRequestWith:'incompatible superclass (in binaryLoad)'.
+		raiseRequestWith:'incompatible superclass (in binaryLoad)'.
-^ nil
+	    ^ nil
-]
+	]
 ].
 name := manager nextObject.
 flags := manager nextObject.
 instvars := manager nextObject.
 classInstVars := manager nextObject.
 classInstVars isNil ifTrue:[classInstVars := ''].
 comment := manager nextObject.
 package := manager nextObject.
 formatID == 1 ifTrue:[
-rev := manager nextObject.
+	rev := manager nextObject.
-ownerName := manager nextObject.
+	ownerName := manager nextObject.
-ownerName notNil ifTrue:[
+	ownerName notNil ifTrue:[
-name := name copyFrom:(ownerName size + 2 + 1).
+	    name := name copyFrom:(ownerName size + 2 + 1).
-owner := Smalltalk at:ownerName.
+	    owner := Smalltalk at:ownerName.
-]
+	]
 ].
 "/    'got superName:' print. superclassName printNL.
 "/    'got name:' print. name printNL.
 "/    'got flags: ' print. flags printNL.
 "/    'got classInstvars: ' print. classInstVars printNL.
 "/ ('create class: ' ,  name ) printNL.
 owner notNil ifTrue:[
-environment := owner
+	environment := owner
 ] ifFalse:[
-environment := Class nameSpaceQuerySignal raise.
+	environment := Class nameSpaceQuerySignal raise.
 ].
 cls := superClass.
 superClass isNil ifTrue:[
-cls := Object
+	cls := Object
 ].
 newClass := cls class
-name:name asSymbol
+	    name:name asSymbol
-in:environment
+	    in:environment
-subclassOf:cls
+	    subclassOf:cls
-instanceVariableNames:instvars
+	    instanceVariableNames:instvars
-variable:false
+	    variable:false
-words:false
+	    words:false
-pointers:true
+	    pointers:true
-classVariableNames:classvars
+	    classVariableNames:classvars
-poolDictionaries:''
+	    poolDictionaries:''
-category:category
+	    category:category
-comment:comment
+	    comment:comment
-changed:false
+	    changed:false
-classInstanceVariableNames:classInstVars.
+	    classInstanceVariableNames:classInstVars.
 newClass isNil ifTrue:[
-^ nil.
+	^ nil.
 ].
 superClass isNil ifTrue:[
-newClass setSuperclass:nil.
+	newClass setSuperclass:nil.
-newClass class setSuperclass:Class.
+	newClass class setSuperclass:Class.
 ].
 "/ Transcript showCR:'loaded ' , name , ' in ' , environment name.
 newClass flags:flags.
 cmethods := MethodDictionary binaryFullDefinitionFrom:stream manager:manager.
 "/ retrieve inst methods
 methods := MethodDictionary binaryFullDefinitionFrom:stream manager:manager.
 formatID == 1 ifTrue:[
-"/ privateClasses
+	"/ privateClasses
-nPrivate := manager nextObject.
+	nPrivate := manager nextObject.
-nPrivate timesRepeat:[
+	nPrivate timesRepeat:[
-Class nameSpaceQuerySignal
+	    Class nameSpaceQuerySignal
-answer:newClass
+		answer:newClass
-do:[
+		do:[
-privateClass := manager nextObject
+		    privateClass := manager nextObject
-]
+		]
-]
+	]
 ].
 (superClass isNil and:[superclassName notNil]) ifTrue:[^ nil].
 newClass isNil ifTrue:[
-^ nil
+	^ nil
 ].
 owner notNil ifTrue:[
-newClass category:nil.
+	newClass category:nil.
 ] ifFalse:[
-newClass package:package.
+	newClass package:package.
 ].
 newClass methodDictionary:methods.
 newClass class methodDictionary:cmethods.
 ^ newClass
 1 storeBinaryOn:stream manager:manager.  "/ formatID
 owner := self owningClass.
 superclass isNil ifTrue:[
-s := nil.
+	s := nil.
-sig := 0.
+	sig := 0.
 ] ifFalse:[
-s := superclass name.
+	s := superclass name.
-sig := superclass signature.
+	sig := superclass signature.
 ].
 s storeBinaryOn:stream manager:manager.
 sig storeBinaryOn:stream manager:manager.
 name storeBinaryOn:stream manager:manager.
 flags storeBinaryOn:stream manager:manager.
 (instvars notNil and:[instvars isEmpty]) ifTrue:[
-s := nil
+	s := nil
 ] ifFalse:[
-s := instvars
+	s := instvars
 ].
 s storeBinaryOn:stream manager:manager.
 (classvars notNil and:[classvars isEmpty]) ifTrue:[
-s := nil
+	s := nil
 ] ifFalse:[
-s := classvars
+	s := classvars
 ].
 s storeBinaryOn:stream manager:manager.
 "/ the category
 owner notNil ifTrue:[
-nil storeBinaryOn:stream manager:manager.
+	nil storeBinaryOn:stream manager:manager.
 ] ifFalse:[
-category storeBinaryOn:stream manager:manager.
+	category storeBinaryOn:stream manager:manager.
 ].
 "/ the classInstVarString
 s := self class instanceVariableString.
 (s notNil and:[s isEmpty]) ifTrue:[
-s := nil
+	s := nil
 ].
 s storeBinaryOn:stream manager:manager.
 "/ the comment
 s := comment.
 manager sourceMode == #discard ifTrue:[
-s := nil
+	s := nil
 ].
 s storeBinaryOn:stream manager:manager.
 "/ the revision, package & owner
 owner notNil ifTrue:[
-nil storeBinaryOn:stream manager:manager.
+	nil storeBinaryOn:stream manager:manager.
-nil storeBinaryOn:stream manager:manager.
+	nil storeBinaryOn:stream manager:manager.
-owner name storeBinaryOn:stream manager:manager.
+	owner name storeBinaryOn:stream manager:manager.
 ] ifFalse:[
-package storeBinaryOn:stream manager:manager.
+	package storeBinaryOn:stream manager:manager.
-revision storeBinaryOn:stream manager:manager.
+	revision storeBinaryOn:stream manager:manager.
-nil storeBinaryOn:stream manager:manager.
+	nil storeBinaryOn:stream manager:manager.
 ].
 "/
 "/ store class method dictionary and methods
 "/
 "/ names of private classes
 "/
 privateClasses := self privateClassesSorted.
 privateClasses size storeBinaryOn:stream manager:manager.
 privateClasses size > 0 ifTrue:[
-privateClasses do:[:aClass |
+	privateClasses do:[:aClass |
-aClass storeBinaryClassOn:stream manager:manager
+	    aClass storeBinaryClassOn:stream manager:manager
-]
+	]
 ].
 "
 |bos|
 output the instance variable name string
 "
 varnames := self allInstVarNames.
 n := varnames size.
 n == 0 ifTrue:[
-sz := 0
+	sz := 0
 ] ifFalse:[
-sz := varnames inject:0 into:[:sum :nm | sum + nm size].
+	sz := varnames inject:0 into:[:sum :nm | sum + nm size].
-sz := sz + n - 1.
+	sz := sz + n - 1.
 ].
 stream nextNumber:2 put:sz.
 varnames keysAndValuesDo:[:i :nm |
-stream nextPutBytes:(nm size) from:nm startingAt:1.
+	stream nextPutBytes:(nm size) from:nm startingAt:1.
 "/        nm do:[:c |
 "/            stream nextPut:c asciiValue
 "/        ].
-i ~~ n ifTrue:[stream nextPut:(Character space asciiValue)]
+	i ~~ n ifTrue:[stream nextPut:(Character space asciiValue)]
 ].
 "
 output my name
 "
 "{ Pragma: +optSpace }"
 "add a category change record to the changes file"
 Class updateChangeFileQuerySignal raise ifTrue:[
-self writingChangePerform:#addChangeRecordForChangeCategory:to: with:category.
+	self writingChangePerform:#addChangeRecordForChangeCategory:to: with:category.
 ]
 "Modified: 4.6.1997 / 14:56:13 / cg"
 !
 "{ Pragma: +optSpace }"
 "add a class-definition-record to the changes file"
 UpdateChangeFileQuerySignal raise ifTrue:[
-self writingChangePerform:#addChangeRecordForClass:to: with:aClass.
+	self writingChangePerform:#addChangeRecordForClass:to: with:aClass.
 ]
 "Modified: 24.1.1997 / 19:09:41 / cg"
 !
 "append a class-was-checkedIn-record to the changes file"
 |rv|
 UpdateChangeFileQuerySignal raise ifTrue:[
-rv := aClass revision.
+	rv := aClass revision.
-rv isNil ifTrue:[rv := '???'].
+	rv isNil ifTrue:[rv := '???'].
-self
+	self
-writingChangeWithTimeStamp:false
+	    writingChangeWithTimeStamp:false
-perform:#addInfoRecord:to:
+	    perform:#addInfoRecord:to:
-with:('checkin ' , aClass name , ' (' , rv , ')').
+	    with:('checkin ' , aClass name , ' (' , rv , ')').
 ]
 "Created: 18.11.1995 / 17:04:58 / cg"
 "Modified: 24.1.1997 / 19:11:55 / cg"
 !
 "{ Pragma: +optSpace }"
 "add a class-comment-record to the changes file"
 UpdateChangeFileQuerySignal raise ifTrue:[
-self writingChangePerform:#addChangeRecordForClassComment:to: with:aClass.
+	self writingChangePerform:#addChangeRecordForClassComment:to: with:aClass.
 ]
 "Modified: 24.1.1997 / 19:09:59 / cg"
 !
 "{ Pragma: +optSpace }"
 "append a container-was-removed-record to the changes file"
 UpdateChangeFileQuerySignal raise ifTrue:[
-self
+	self
-writingChangeWithTimeStamp:false
+	    writingChangeWithTimeStamp:false
-perform:#addInfoRecord:to:
+	    perform:#addInfoRecord:to:
-with:('removed source container of ' , aClass name).
+	    with:('removed source container of ' , aClass name).
 ]
 "Created: 11.9.1996 / 15:37:19 / cg"
 "Modified: 24.1.1997 / 19:12:05 / cg"
 !
 "{ Pragma: +optSpace }"
 "append a class-was-filedOut-record to the changes file"
 UpdateChangeFileQuerySignal raise ifTrue:[
-self
+	self
-writingChangeWithTimeStamp:false
+	    writingChangeWithTimeStamp:false
-perform:#addInfoRecord:to:
+	    perform:#addInfoRecord:to:
-with:('fileOut ' , aClass name).
+	    with:('fileOut ' , aClass name).
 ]
 "Modified: 24.1.1997 / 19:12:14 / cg"
 !
 "{ Pragma: +optSpace }"
 "add a class-instvars-record to the changes file"
 UpdateChangeFileQuerySignal raise ifTrue:[
-self writingChangePerform:#addChangeRecordForClassInstvars:to: with:aClass.
+	self writingChangePerform:#addChangeRecordForClassInstvars:to: with:aClass.
 ]
 "Modified: 24.1.1997 / 19:10:18 / cg"
 !
 "{ Pragma: +optSpace }"
 "add a class-remove-record to the changes file"
 UpdateChangeFileQuerySignal raise ifTrue:[
-self writingChangePerform:#addChangeRecordForClassRemove:to: with:oldName.
+	self writingChangePerform:#addChangeRecordForClassRemove:to: with:oldName.
 ]
 "Modified: 24.1.1997 / 19:10:25 / cg"
 !
 "{ Pragma: +optSpace }"
 "add a class-rename-record to the changes file"
 UpdateChangeFileQuerySignal raise ifTrue:[
-self writingChangeDo:[:aStream |
+	self writingChangeDo:[:aStream |
-self addChangeRecordForClassRename:oldName to:newName to:aStream
+	    self addChangeRecordForClassRename:oldName to:newName to:aStream
-]
+	]
 ]
 "Modified: 24.1.1997 / 19:10:35 / cg"
 !
 "{ Pragma: +optSpace }"
 "add a primitiveDefinitions-record to the changes file"
 UpdateChangeFileQuerySignal raise ifTrue:[
-self writingChangePerform:#addChangeRecordForPrimitiveDefinitions:to: with:aClass.
+	self writingChangePerform:#addChangeRecordForPrimitiveDefinitions:to: with:aClass.
-Project notNil ifTrue:[
+	Project notNil ifTrue:[
-Project addPrimitiveDefinitionsChangeFor:aClass
+	    Project addPrimitiveDefinitionsChangeFor:aClass
-]
+	]
 ]
 "Modified: 20.1.1997 / 12:36:10 / cg"
 !
 "{ Pragma: +optSpace }"
 "add a primitiveFunctions-record to the changes file"
 UpdateChangeFileQuerySignal raise ifTrue:[
-self writingChangePerform:#addChangeRecordForPrimitiveFunctions:to: with:aClass.
+	self writingChangePerform:#addChangeRecordForPrimitiveFunctions:to: with:aClass.
-Project notNil ifTrue:[
+	Project notNil ifTrue:[
-Project addPrimitiveFunctionsChangeFor:aClass
+	    Project addPrimitiveFunctionsChangeFor:aClass
-]
+	]
 ]
 "Modified: 20.1.1997 / 12:36:13 / cg"
 !
 "{ Pragma: +optSpace }"
 "add a primitiveVariables-record to the changes file"
 UpdateChangeFileQuerySignal raise ifTrue:[
-self writingChangePerform:#addChangeRecordForPrimitiveVariables:to: with:aClass.
+	self writingChangePerform:#addChangeRecordForPrimitiveVariables:to: with:aClass.
-Project notNil ifTrue:[
+	Project notNil ifTrue:[
-Project addPrimitiveVariablesChangeFor:aClass
+	    Project addPrimitiveVariablesChangeFor:aClass
-]
+	]
 ]
 "Modified: 20.1.1997 / 12:36:16 / cg"
 !
 "{ Pragma: +optSpace }"
 "add a snapshot-record to the changes file"
 UpdateChangeFileQuerySignal raise ifTrue:[
-self
+	self
-writingChangeWithTimeStamp:false
+	    writingChangeWithTimeStamp:false
-perform:#addInfoRecord:to:
+	    perform:#addInfoRecord:to:
-with:('snapshot ' , aFileName).
+	    with:('snapshot ' , aFileName).
 ]
 "Modified: 24.1.1997 / 19:12:25 / cg"
 !
 "{ Pragma: +optSpace }"
 "add a snapshot-record to aStream"
 UpdateChangeFileQuerySignal raise ifTrue:[
-self addInfoRecord:('snapshot ' , aFileName) to:aStream
+	self addInfoRecord:('snapshot ' , aFileName) to:aStream
 ]
 "Modified: 24.1.1997 / 19:11:08 / cg"
 ! !
 "evaluate aBlock on all of my private classes (if any)"
 |classes|
 (classes := self privateClasses) size > 0 ifTrue:[
-classes do:aBlock
+	classes do:aBlock
 ].
 "Created: 26.10.1996 / 12:28:57 / cg"
 "Modified: 22.3.1997 / 16:17:36 / cg"
 ! !
 syntaxHilighting := Smalltalk syntaxHilighting.
 owner := self owningClass.
 owner isNil ifTrue:[
-ns := self nameSpace.
+	ns := self nameSpace.
 ] ifFalse:[
-ns := self topOwningClass nameSpace
+	ns := self topOwningClass nameSpace
 ].
 fullName := FileOutNameSpaceQuerySignal raise == true.
 ((owner isNil and:[fullName not])
 or:[owner notNil and:[forceNameSpace and:[fullName not]]]) ifTrue:[
-(ns notNil and:[ns ~~ Smalltalk]) ifTrue:[
+	(ns notNil and:[ns ~~ Smalltalk]) ifTrue:[
-nsName := ns name.
+	    nsName := ns name.
-(nsName includes:$:) ifTrue:[
+	    (nsName includes:$:) ifTrue:[
-nsName := '''' , nsName , ''''
+		nsName := '''' , nsName , ''''
-].
+	    ].
 "/            aStream nextPutLine:'"{ NameSpace: ' , nsName , ' }"'; cr.
-aStream nextPutAll:'"{ NameSpace: '.
+	    aStream nextPutAll:'"{ NameSpace: '.
-syntaxHilighting ifTrue:[aStream bold].
+	    syntaxHilighting ifTrue:[aStream bold].
-aStream nextPutAll:nsName.
+	    aStream nextPutAll:nsName.
-syntaxHilighting ifTrue:[aStream normal].
+	    syntaxHilighting ifTrue:[aStream normal].
-aStream nextPutAll:' }"'; cr; cr.
+	    aStream nextPutAll:' }"'; cr; cr.
-]
+	]
 ].
 "take care of nil-superclass"
 superclass isNil ifTrue:[
-s := 'nil'
+	s := 'nil'
 ] ifFalse:[
-fullName ifTrue:[
+	fullName ifTrue:[
-s := superclass name
+	    s := superclass name
-] ifFalse:[
+	] ifFalse:[
-(ns == superclass nameSpace
+	    (ns == superclass nameSpace
-and:[superclass owningClass isNil]) ifTrue:[
+	    and:[superclass owningClass isNil]) ifTrue:[
-s := superclass nameWithoutPrefix
+		s := superclass nameWithoutPrefix
-] ifFalse:[
+	    ] ifFalse:[
-"/ a very special (rare) situation:
+		"/ a very special (rare) situation:
-"/ my superclass resides in another nameSpace,
+		"/ my superclass resides in another nameSpace,
-"/ but there is something else named like this
+		"/ but there is something else named like this
-"/ to be found in my nameSpace (or a private class)
+		"/ to be found in my nameSpace (or a private class)
-superName := superclass nameWithoutNameSpacePrefix asSymbol.
+		superName := superclass nameWithoutNameSpacePrefix asSymbol.
-cls := self privateClassesAt:superName.
+		cls := self privateClassesAt:superName.
-cls isNil ifTrue:[
+		cls isNil ifTrue:[
-(topOwner := self topOwningClass) isNil ifTrue:[
+		    (topOwner := self topOwningClass) isNil ifTrue:[
-ns := self nameSpace.
+			ns := self nameSpace.
-ns notNil ifTrue:[
+			ns notNil ifTrue:[
-cls := ns privateClassesAt:superName
+			    cls := ns privateClassesAt:superName
-] ifFalse:[
+			] ifFalse:[
-"/ self error:'unexpected nil namespace'
+			    "/ self error:'unexpected nil namespace'
-]
+			]
-] ifFalse:[
+		    ] ifFalse:[
-cls := topOwner nameSpace at:superName.
+			cls := topOwner nameSpace at:superName.
-]
+		    ]
-].
+		].
-(cls notNil and:[cls ~~ superclass]) ifTrue:[
+		(cls notNil and:[cls ~~ superclass]) ifTrue:[
-s := superclass nameSpace name , '::' , superName
+		    s := superclass nameSpace name , '::' , superName
-] ifFalse:[
+		] ifFalse:[
-s := superName
+		    s := superName
-]
+		]
-]
+	    ]
-]
+	]
 ].
 syntaxHilighting ifTrue:[aStream bold].
 aStream nextPutAll:s.   "/ superclass
 syntaxHilighting ifTrue:[aStream normal].
 aStream space.
 self basicFileOutInstvarTypeKeywordOn:aStream.
 (fullName and:[owner isNil]) ifTrue:[
-aStream nextPutAll:'#'''.
+	aStream nextPutAll:'#'''.
-syntaxHilighting ifTrue:[aStream bold].
+	syntaxHilighting ifTrue:[aStream bold].
-aStream nextPutAll:(self name).
+	aStream nextPutAll:(self name).
-syntaxHilighting ifTrue:[aStream normal].
+	syntaxHilighting ifTrue:[aStream normal].
-aStream nextPutAll:''''.
+	aStream nextPutAll:''''.
 ] ifFalse:[
-aStream nextPut:$#.
+	aStream nextPut:$#.
-syntaxHilighting ifTrue:[aStream bold].
+	syntaxHilighting ifTrue:[aStream bold].
-aStream nextPutAll:(self nameWithoutPrefix).
+	aStream nextPutAll:(self nameWithoutPrefix).
-syntaxHilighting ifTrue:[aStream normal].
+	syntaxHilighting ifTrue:[aStream normal].
 ].
 aStream crtab.
 aStream nextPutAll:'instanceVariableNames:'''.
 syntaxHilighting ifTrue:[aStream bold].
 aStream crtab.
 aStream nextPutAll:'poolDictionaries:'''''.
 aStream crtab.
 owner isNil ifTrue:[
-"/ a public class
+	"/ a public class
-aStream nextPutAll:'category:'.
+	aStream nextPutAll:'category:'.
-category isNil ifTrue:[
+	category isNil ifTrue:[
-s := ''''''
+	    s := ''''''
-] ifFalse:[
+	] ifFalse:[
-s := category asString storeString
+	    s := category asString storeString
-].
+	].
-aStream nextPutAll:s.
+	aStream nextPutAll:s.
 ] ifFalse:[
-"/ a private class
+	"/ a private class
-aStream nextPutAll:'privateIn:'.
+	aStream nextPutAll:'privateIn:'.
-syntaxHilighting ifTrue:[aStream bold].
+	syntaxHilighting ifTrue:[aStream bold].
-fullName ifTrue:[
+	fullName ifTrue:[
-s := owner name.
+	    s := owner name.
-] ifFalse:[
+	] ifFalse:[
-s := owner nameWithoutNameSpacePrefix.
+	    s := owner nameWithoutNameSpacePrefix.
-].
+	].
-aStream nextPutAll:s.
+	aStream nextPutAll:s.
-syntaxHilighting ifTrue:[aStream normal].
+	syntaxHilighting ifTrue:[aStream normal].
 ].
 aStream cr
 "Created: 4.1.1997 / 20:38:16 / cg"
 "Modified: 8.8.1997 / 10:59:50 / cg"
 "a helper for fileOutDefinition"
 |isVar s|
 superclass isNil ifTrue:[
-isVar := self isVariable
+	isVar := self isVariable
 ] ifFalse:[
-"I cant remember what this is for ?"
+	"I cant remember what this is for ?"
-isVar := (self isVariable and:[superclass isVariable not])
+	isVar := (self isVariable and:[superclass isVariable not])
 ].
 isVar ifTrue:[
-self isBytes ifTrue:[
+	self isBytes ifTrue:[
-s := 'variableByteSubclass:'
+	    s := 'variableByteSubclass:'
-] ifFalse:[
+	] ifFalse:[
-self isWords ifTrue:[
+	    self isWords ifTrue:[
-s := 'variableWordSubclass:'
+		s := 'variableWordSubclass:'
-] ifFalse:[
+	    ] ifFalse:[
-self isLongs ifTrue:[
+		self isLongs ifTrue:[
-s := 'variableLongSubclass:'
+		    s := 'variableLongSubclass:'
-] ifFalse:[
+		] ifFalse:[
-self isFloats ifTrue:[
+		    self isFloats ifTrue:[
-s := 'variableFloatSubclass:'
+			s := 'variableFloatSubclass:'
-] ifFalse:[
+		    ] ifFalse:[
-self isDoubles ifTrue:[
+			self isDoubles ifTrue:[
-s := 'variableDoubleSubclass:'
+			    s := 'variableDoubleSubclass:'
-] ifFalse:[
+			] ifFalse:[
-self isSignedWords ifTrue:[
+			    self isSignedWords ifTrue:[
-s := 'variableSignedWordSubclass:'
+				s := 'variableSignedWordSubclass:'
-] ifFalse:[
+			    ] ifFalse:[
-self isSignedLongs ifTrue:[
+				self isSignedLongs ifTrue:[
-s := 'variableSignedLongSubclass:'
+				    s := 'variableSignedLongSubclass:'
-] ifFalse:[
+				] ifFalse:[
-s := 'variableSubclass:'
+				    s := 'variableSubclass:'
-]
+				]
-]
+			    ]
-]
+			]
-]
+		    ]
-]
+		]
-]
+	    ]
-]
+	]
 ] ifFalse:[
-s := 'subclass:'
+	s := 'subclass:'
 ].
 aStream nextPutAll:s.
 "Created: 11.10.1996 / 18:57:29 / cg"
 !
 binaryFileOutWithSourceMode:sourceMode
 "create a file 'class.cls' (in the current projects fileOut-directory),
 consisting of all methods in myself in a portable binary format.
 The argument controls how sources are to be saved:
-#keep - include the source
+	#keep - include the source
-#reference - include a reference to the sourceFile
+	#reference - include a reference to the sourceFile
-#discard - dont save sources.
+	#discard - dont save sources.
 With #reference, the sourceFile needs to be present after reload
 in order to be browsable."
 |baseName fileName aStream dirName|
 baseName := (Smalltalk fileNameForClass:self name).
 fileName := baseName , '.cls'.
 Project notNil ifTrue:[
-dirName := Project currentProjectDirectory
+	dirName := Project currentProjectDirectory
 ] ifFalse:[
-dirName := '.'
+	dirName := '.'
 ].
 fileName := dirName asFilename constructString:fileName.
 aStream := FileStream newFileNamed:fileName.
 aStream isNil ifTrue:[
-^ FileOutErrorSignal
+	^ FileOutErrorSignal
-raiseRequestWith:fileName
+		raiseRequestWith:fileName
-errorString:('cannot create file:', fileName)
+		errorString:('cannot create file:', fileName)
 ].
 aStream binary.
 self binaryFileOutOn:aStream sourceMode:sourceMode.
 aStream close.
 "
 this test allows a smalltalk to be built without Projects/ChangeSets
 "
 Project notNil ifTrue:[
-dirName := Project currentProjectDirectory
+	dirName := Project currentProjectDirectory
 ] ifFalse:[
-dirName := Filename currentDirectory
+	dirName := Filename currentDirectory
 ].
 fileNameString := (dirName asFilename construct:fileNameString) name.
 self fileOutAs:fileNameString.
 "/
 "/ optional classInstanceVariables
 "/
 self class instanceVariableString isBlank ifFalse:[
-self fileOutClassInstVarDefinitionOn:aStream.
+	self fileOutClassInstVarDefinitionOn:aStream.
-aStream nextPutChunkSeparator.
+	aStream nextPutChunkSeparator.
-aStream cr; cr
+	aStream cr; cr
 ].
 self privateClassesSorted do:[:aClass |
-aClass fileOutAllDefinitionsOn:aStream
+	aClass fileOutAllDefinitionsOn:aStream
 ]
 "Created: 15.10.1996 / 11:15:19 / cg"
 "Modified: 22.3.1997 / 16:11:56 / cg"
 !
 fileOutAllMethodsOn:aStream
 |collectionOfCategories|
 collectionOfCategories := self class categories asSortedCollection.
 collectionOfCategories notNil ifTrue:[
-collectionOfCategories do:[:aCategory |
+	collectionOfCategories do:[:aCategory |
-self class fileOutCategory:aCategory on:aStream.
+	    self class fileOutCategory:aCategory on:aStream.
-aStream cr
+	    aStream cr
-]
+	]
 ].
 collectionOfCategories := self categories asSortedCollection.
 collectionOfCategories notNil ifTrue:[
-collectionOfCategories do:[:aCategory |
+	collectionOfCategories do:[:aCategory |
-self fileOutCategory:aCategory on:aStream.
+	    self fileOutCategory:aCategory on:aStream.
-aStream cr
+	    aStream cr
-]
+	]
 ].
 self privateClassesSorted do:[:aClass |
-aClass fileOutAllMethodsOn:aStream
+	aClass fileOutAllMethodsOn:aStream
 ].
 "Created: 15.10.1996 / 11:13:00 / cg"
 "Modified: 22.3.1997 / 16:12:17 / cg"
 !
 if file exists, copy the existing to a .sav-file,
 create the new file as XXX.new-file,
 and, if that worked rename afterwards ...
 "
 (fileName exists) ifTrue:[
-sameFile := false.
+	sameFile := false.
-"/ check carefully - maybe, my source does not really come from that
+	"/ check carefully - maybe, my source does not really come from that
-"/ file (i.e. all of my methods have their source as string)
+	"/ file (i.e. all of my methods have their source as string)
-anySourceRef := false.
+	anySourceRef := false.
-self methodDictionary do:[:m|
+	self methodDictionary do:[:m|
-m sourcePosition notNil ifTrue:[
+	    m sourcePosition notNil ifTrue:[
-anySourceRef := true
+		anySourceRef := true
-]
+	    ]
-].
+	].
-self class methodDictionary do:[:m|
+	self class methodDictionary do:[:m|
-m sourcePosition notNil ifTrue:[
+	    m sourcePosition notNil ifTrue:[
-anySourceRef := true
+		anySourceRef := true
-]
+	    ]
-].
+	].
-anySourceRef ifTrue:[
+	anySourceRef ifTrue:[
-s := self sourceStream.
+	    s := self sourceStream.
-s notNil ifTrue:[
+	    s notNil ifTrue:[
-mySourceFileID := s pathName asFilename info id.
+		mySourceFileID := s pathName asFilename info id.
-sameFile := (fileName info id) == mySourceFileID.
+		sameFile := (fileName info id) == mySourceFileID.
-s close.
+		s close.
-] ifFalse:[
+	    ] ifFalse:[
-classFilename notNil ifTrue:[
+		classFilename notNil ifTrue:[
-"
+		    "
-check for overwriting my current source file
+		     check for overwriting my current source file
-this is not allowed, since it would clobber my methods source
+		     this is not allowed, since it would clobber my methods source
-file ... you have to save it to some other place.
+		     file ... you have to save it to some other place.
-This happens if you ask for a fileOut into the source-directory
+		     This happens if you ask for a fileOut into the source-directory
-(from which my methods get their source)
+		     (from which my methods get their source)
-"
+		    "
-mySourceFileName := Smalltalk getSourceFileName:classFilename.
+		    mySourceFileName := Smalltalk getSourceFileName:classFilename.
-sameFile := (fileNameString = mySourceFileName).
+		    sameFile := (fileNameString = mySourceFileName).
-sameFile ifFalse:[
+		    sameFile ifFalse:[
-mySourceFileName notNil ifTrue:[
+			mySourceFileName notNil ifTrue:[
-sameFile := (fileName info id) == (mySourceFileName asFilename info id)
+			    sameFile := (fileName info id) == (mySourceFileName asFilename info id)
-]
+			]
-].
+		    ].
-]
+		]
-].
+	    ].
-].
+	].
-sameFile ifTrue:[
+	sameFile ifTrue:[
-^ FileOutErrorSignal
+	    ^ FileOutErrorSignal
-raiseRequestWith:fileNameString
+		raiseRequestWith:fileNameString
-errorString:('may not overwrite sourcefile:', fileNameString)
+		errorString:('may not overwrite sourcefile:', fileNameString)
-].
+	].
 	savFilename := Filename newTemporary.
-fileName copyTo:savFilename.
+	fileName copyTo:savFilename.
-newFileName := fileName withSuffix:'new'.
+	newFileName := fileName withSuffix:'new'.
-needRename := true
+	needRename := true
 ] ifFalse:[
-newFileName := fileName.
+	newFileName := fileName.
-needRename := false
+	needRename := false
 ].
 aStream := newFileName writeStream.
 aStream isNil ifTrue:[
 	savFilename notNil ifTrue:[
 	    savFilename delete
 	].
-^ FileOutErrorSignal
+	^ FileOutErrorSignal
-raiseRequestWith:newFileName
+		raiseRequestWith:newFileName
-errorString:('cannot create file:', newFileName name)
+		errorString:('cannot create file:', newFileName name)
 ].
 self fileOutOn:aStream.
 aStream close.
 "
 finally, replace the old-file
 be careful, if the old one is a symbolic link; in this case,
 we have to do a copy ...
 "
 needRename ifTrue:[
-newFileName copyTo:fileName.
+	newFileName copyTo:fileName.
-newFileName delete
+	newFileName delete
 ].
 savFilename notNil ifTrue:[
 	savFilename delete
 ].
 "mhmh - good idea; saw this in SmallDraw sourcecode ..."
 aStream cr; cr; nextPut:(Character doubleQuote); cr.
 aStream space;
-nextPutLine:'The following class instance variables are inherited by this class:';
+	    nextPutLine:'The following class instance variables are inherited by this class:';
-cr.
+	    cr.
 self allSuperclassesDo:[:aSuperClass |
-aStream tab; nextPutAll:aSuperClass name; nextPutAll:' - '.
+	aStream tab; nextPutAll:aSuperClass name; nextPutAll:' - '.
-aStream nextPutLine:(aSuperClass class instanceVariableString).
+	aStream nextPutLine:(aSuperClass class instanceVariableString).
 ].
 aStream nextPut:(Character doubleQuote); cr.
 "Created: 10.12.1995 / 16:31:25 / cg"
 "Modified: 9.11.1996 / 00:11:07 / cg"
 |comment s|
 self printClassNameOn:aStream.
 aStream nextPutAll:' comment:'.
 (comment := self comment) isNil ifTrue:[
-s := ''''''
+	s := ''''''
 ] ifFalse:[
-s := comment storeString
+	s := comment storeString
 ].
 aStream nextPutAllAsChunk:s.
 aStream nextPutChunkSeparator.
 aStream cr
 |aStream fileName|
 fileName := (Smalltalk fileNameForClass:self name), '.st'.
 aStream := (aDirectoryName asFilename construct:fileName) writeStream.
 aStream isNil ifTrue:[
-^ FileOutErrorSignal
+	^ FileOutErrorSignal
-raiseRequestWith:fileName
+		raiseRequestWith:fileName
-errorString:('cannot create file:', fileName)
+		errorString:('cannot create file:', fileName)
 ].
 self fileOutOn:aStream.
 aStream close
 "
-self fileOutIn:'/tmp'
+	self fileOutIn:'/tmp'
-self fileOutIn:'/tmp' asFilename
+	self fileOutIn:'/tmp' asFilename
 "
 "Modified: 19.9.1997 / 00:03:53 / stefan"
 !
 |collectionOfCategories copyrightMethod copyrightText comment versionMethod skippedMethods
 meta|
 self isLoaded ifFalse:[
-^ FileOutErrorSignal
+	^ FileOutErrorSignal
-raiseRequestWith:self
+	    raiseRequestWith:self
-errorString:'will not fileOut unloaded classes'
+		 errorString:'will not fileOut unloaded classes'
 ].
 meta := self class.
 "
 On the other hand: I want every file created by myself to have the
 copyright string at the beginning be preserved .... even if the
 code was edited in the browser and filedOut.
 "
 (copyrightMethod := meta compiledMethodAt:#copyright) notNil ifTrue:[
-"
+	"
-get the copyright methods source,
+	 get the copyright methods source,
-and insert at beginning.
+	 and insert at beginning.
-"
+	"
-copyrightText := copyrightMethod source.
+	copyrightText := copyrightMethod source.
-copyrightText isNil ifTrue:[
+	copyrightText isNil ifTrue:[
-"
+	    "
-no source available - trigger an error
+	     no source available - trigger an error
-"
+	    "
-FileOutErrorSignal
+	    FileOutErrorSignal
-raiseRequestWith:'no source for class ' , self name , ' available. Cannot fileOut'.
+		raiseRequestWith:'no source for class ' , self name , ' available. Cannot fileOut'.
-^ self
+	    ^ self
-].
+	].
-"
+	"
-strip off the selector-line
+	 strip off the selector-line
-"
+	"
-copyrightText := copyrightText asCollectionOfLines asStringCollection.
+	copyrightText := copyrightText asCollectionOfLines asStringCollection.
-copyrightText := copyrightText copyFrom:2 to:(copyrightText size).
+	copyrightText := copyrightText copyFrom:2 to:(copyrightText size).
 "/        copyrightText do:[:line | aStream nextPutAll:line. aStream cr.].
-copyrightText := copyrightText asString.
+	copyrightText := copyrightText asString.
-aStream nextPutAllAsChunk:copyrightText.
+	aStream nextPutAllAsChunk:copyrightText.
 ].
 stampIt ifTrue:[
-"/
+	"/
-"/ first, a timestamp
+	"/ first, a timestamp
-"/
+	"/
-aStream nextPutAll:(Smalltalk timeStamp).
+	aStream nextPutAll:(Smalltalk timeStamp).
-aStream nextPutChunkSeparator.
+	aStream nextPutChunkSeparator.
-aStream cr; cr.
+	aStream cr; cr.
 ].
 "/
 "/ then the definition
 "/
 "/
 "/ a comment - if any
 "/
 (comment := self comment) notNil ifTrue:[
-self fileOutCommentOn:aStream.
+	self fileOutCommentOn:aStream.
-aStream cr.
+	aStream cr.
 ].
 "/
 "/ primitive definitions - if any
 "/
 "/         avoid sourcePosition-shifts when checked out later.
 "/         (RCS expands this string, so its size is not constant)
 "/
 collectionOfCategories := meta categories asSortedCollection.
 collectionOfCategories notNil ifTrue:[
-"/
+	"/
-"/ documentation first (if any), but not the version method
+	"/ documentation first (if any), but not the version method
-"/
+	"/
-(collectionOfCategories includes:'documentation') ifTrue:[
+	(collectionOfCategories includes:'documentation') ifTrue:[
-versionMethod := meta compiledMethodAt:#version.
+	    versionMethod := meta compiledMethodAt:#version.
-versionMethod notNil ifTrue:[
+	    versionMethod notNil ifTrue:[
-skippedMethods := Array with:versionMethod
+		skippedMethods := Array with:versionMethod
-].
+	    ].
-meta fileOutCategory:'documentation' except:skippedMethods only:nil on:aStream.
+	    meta fileOutCategory:'documentation' except:skippedMethods only:nil on:aStream.
-aStream cr.
+	    aStream cr.
-].
+	].
-"/
+	"/
-"/ initialization next (if any)
+	"/ initialization next (if any)
-"/
+	"/
-(collectionOfCategories includes:'initialization') ifTrue:[
+	(collectionOfCategories includes:'initialization') ifTrue:[
-meta fileOutCategory:'initialization' on:aStream.
+	    meta fileOutCategory:'initialization' on:aStream.
-aStream cr.
+	    aStream cr.
-].
+	].
-"/
+	"/
-"/ instance creation next (if any)
+	"/ instance creation next (if any)
-"/
+	"/
-(collectionOfCategories includes:'instance creation') ifTrue:[
+	(collectionOfCategories includes:'instance creation') ifTrue:[
-meta fileOutCategory:'instance creation' on:aStream.
+	    meta fileOutCategory:'instance creation' on:aStream.
-aStream cr.
+	    aStream cr.
-].
+	].
-collectionOfCategories do:[:aCategory |
+	collectionOfCategories do:[:aCategory |
-((aCategory ~= 'documentation')
+	    ((aCategory ~= 'documentation')
-and:[(aCategory ~= 'initialization')
+	    and:[(aCategory ~= 'initialization')
-and:[aCategory ~= 'instance creation']]) ifTrue:[
+	    and:[aCategory ~= 'instance creation']]) ifTrue:[
-meta fileOutCategory:aCategory on:aStream.
+		meta fileOutCategory:aCategory on:aStream.
-aStream cr
+		aStream cr
-]
+	    ]
-]
+	]
 ].
 "/
 "/ methods from all categories in myself
 "/
 collectionOfCategories := self categories asSortedCollection.
 collectionOfCategories notNil ifTrue:[
-collectionOfCategories do:[:aCategory |
+	collectionOfCategories do:[:aCategory |
-self fileOutCategory:aCategory on:aStream.
+	    self fileOutCategory:aCategory on:aStream.
-aStream cr
+	    aStream cr
-]
+	]
 ].
 "/
 "/ any private classes' methods
 "/
 self privateClassesSorted do:[:aClass |
-aClass fileOutAllMethodsOn:aStream
+	aClass fileOutAllMethodsOn:aStream
 ].
 "/
 "/ finally, the previously skipped version method
 "/
 versionMethod notNil ifTrue:[
-meta fileOutCategory:'documentation' except:nil only:skippedMethods on:aStream.
+	meta fileOutCategory:'documentation' except:nil only:skippedMethods on:aStream.
 ].
 "/
 "/ optionally an initialize message
 "/
 (meta implements:#initialize) ifTrue:[
-self printClassNameOn:aStream. aStream nextPutAll:' initialize'.
+	self printClassNameOn:aStream. aStream nextPutAll:' initialize'.
-aStream nextPutChunkSeparator.
+	aStream nextPutChunkSeparator.
-aStream cr
+	aStream cr
 ]
 "Created: 15.11.1995 / 12:53:06 / cg"
 "Modified: 22.3.1997 / 16:12:47 / cg"
 "Modified: 1.4.1997 / 16:01:05 / stefan"
 "
 primitive definitions - if any
 "
 (s := self primitiveDefinitionsString) notNil ifTrue:[
-aStream nextPutChunkSeparator.
+	aStream nextPutChunkSeparator.
-self printClassNameOn:aStream.
+	self printClassNameOn:aStream.
-aStream nextPutAll:' primitiveDefinitions';
+	aStream nextPutAll:' primitiveDefinitions';
-nextPutChunkSeparator;
+		nextPutChunkSeparator;
-cr.
+		cr.
-aStream nextPutAll:s.
+	aStream nextPutAll:s.
-aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
+	aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
 ].
 (s := self primitiveVariablesString) notNil ifTrue:[
-aStream nextPutChunkSeparator.
+	aStream nextPutChunkSeparator.
-self printClassNameOn:aStream.
+	self printClassNameOn:aStream.
-aStream nextPutAll:' primitiveVariables';
+	aStream nextPutAll:' primitiveVariables';
-nextPutChunkSeparator;
+		nextPutChunkSeparator;
-cr.
+		cr.
-aStream nextPutAll:s.
+	aStream nextPutAll:s.
-aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
+	aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
 ].
 "Modified: 8.1.1997 / 17:45:40 / cg"
 !
 self fileOutPrimitiveDefinitionsOn:aStream.
 "
 primitive functions - if any
 "
 (s := self primitiveFunctionsString) notNil ifTrue:[
-aStream nextPutChunkSeparator.
+	aStream nextPutChunkSeparator.
-self printClassNameOn:aStream.
+	self printClassNameOn:aStream.
-aStream nextPutAll:' primitiveFunctions';
+	aStream nextPutAll:' primitiveFunctions';
-nextPutChunkSeparator;
+		nextPutChunkSeparator;
-cr.
+		cr.
-aStream nextPutAll:s.
+	aStream nextPutAll:s.
-aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
+	aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
 ].
 "Modified: 8.1.1997 / 17:45:51 / cg"
 ! !
 aStream spaces:indent; bold; nextPutAll:nm; normal; nextPutAll:' ('.
 self printInstVarNamesOn:aStream indent:(indent + nm size + 2).
 aStream nextPutLine:')'.
 (self subclasses sort:[:a :b | a name < b name]) do:[:aSubclass |
-aSubclass printFullHierarchyOn:aStream indent:(indent + 2)
+	aSubclass printFullHierarchyOn:aStream indent:(indent + 2)
 ]
 "|printStream|
 printStream := Printer new.
 Object printFullHierarchyOn:printStream indent:0.
 |dict any|
 dict := self methodDictionary.
 dict notNil ifTrue:[
-any := false.
+	any := false.
-dict do:[:aMethod |
+	dict do:[:aMethod |
-(aCategory = aMethod category) ifTrue:[
+	    (aCategory = aMethod category) ifTrue:[
-any := true
+		any := true
-]
+	    ]
-].
+	].
-any ifTrue:[
+	any ifTrue:[
-aPrintStream italic.
+	     aPrintStream italic.
-aPrintStream nextPutAll:aCategory.
+	     aPrintStream nextPutAll:aCategory.
-aPrintStream normal.
+	     aPrintStream normal.
-aPrintStream cr; cr.
+	     aPrintStream cr; cr.
-dict do:[:aMethod |
+	     dict do:[:aMethod |
-(aCategory = aMethod category) ifTrue:[
+		 (aCategory = aMethod category) ifTrue:[
-self printOutSource:(aMethod source) on:aPrintStream.
+		     self printOutSource:(aMethod source) on:aPrintStream.
-aPrintStream cr; cr
+		     aPrintStream cr; cr
-]
+		 ]
-].
+	     ].
-aPrintStream cr
+	     aPrintStream cr
-]
+	 ]
 ]
 "Modified: 12.6.1996 / 11:47:36 / stefan"
 !
 |comment s|
 aPrintStream nextPutAll:'class                '; bold; nextPutLine:self name; normal.
 aPrintStream nextPutAll:'superclass           '.
 superclass isNil ifTrue:[
-s := 'Object'
+	s := 'Object'
 ] ifFalse:[
-s := superclass name
+	s := superclass name
 ].
 aPrintStream nextPutLine:s.
 aPrintStream nextPutAll:'instance Variables   '.
 self printInstVarNamesOn:aPrintStream indent:21.
 aPrintStream nextPutAll:'class Variables      '.
 self printClassVarNamesOn:aPrintStream indent:21.
 aPrintStream cr.
 category notNil ifTrue:[
-aPrintStream nextPutAll:'category             ';
+	aPrintStream nextPutAll:'category             ';
-nextPutLine:(category printString).
+		     nextPutLine:(category printString).
 ].
 (comment := self comment) notNil ifTrue:[
-aPrintStream cr; nextPutLine:'comment:'; italic; nextPutLine:comment; normal
+	aPrintStream cr; nextPutLine:'comment:'; italic; nextPutLine:comment; normal
 ]
 "Created: 10.12.1995 / 16:30:47 / cg"
 "Modified: 9.11.1996 / 00:13:37 / cg"
 "Modified: 1.4.1997 / 16:01:26 / stefan"
 self printOutDefinitionOn:aPrintStream.
 aPrintStream cr.
 collectionOfCategories := self class categories.
 collectionOfCategories notNil ifTrue:[
-aPrintStream nextPutLine:'class protocol'.
+	aPrintStream nextPutLine:'class protocol'.
-aPrintStream cr.
+	aPrintStream cr.
-collectionOfCategories do:[:aCategory |
+	collectionOfCategories do:[:aCategory |
-self class printOutCategory:aCategory on:aPrintStream
+	    self class printOutCategory:aCategory on:aPrintStream
-]
+	]
 ].
 collectionOfCategories := self categories.
 collectionOfCategories notNil ifTrue:[
-aPrintStream nextPutLine:'instance protocol'.
+	aPrintStream nextPutLine:'instance protocol'.
-aPrintStream cr.
+	aPrintStream cr.
-collectionOfCategories do:[:aCategory |
+	collectionOfCategories do:[:aCategory |
-self printOutCategory:aCategory on:aPrintStream
+	    self printOutCategory:aCategory on:aPrintStream
-]
+	]
 ]
 "Modified: 9.11.1996 / 00:14:11 / cg"
 !
 "{ Pragma: +optSpace }"
 "append a primitiveDefinitions-record to aStream"
 aStream nextPutAll:aClass name; nextPutLine:' primitiveDefinitions:''';
-nextPutAll:(aClass primitiveDefinitionsString storeString copyFrom:2).
+	    nextPutAll:(aClass primitiveDefinitionsString storeString copyFrom:2).
 aStream nextPutChunkSeparator.
 "Modified: 9.11.1996 / 00:09:54 / cg"
 !
 "{ Pragma: +optSpace }"
 "append a primitiveFunctions-record to aStream"
 aStream nextPutAll:aClass name; nextPutLine:' primitiveFunctions:''';
-nextPutAll:(aClass primitiveFunctionsString storeString copyFrom:2).
+	    nextPutAll:(aClass primitiveFunctionsString storeString copyFrom:2).
 aStream nextPutChunkSeparator.
 "Modified: 9.11.1996 / 00:10:02 / cg"
 !
 "{ Pragma: +optSpace }"
 "append a primitiveVariables-record to aStream"
 aStream nextPutAll:aClass name; nextPutLine:' primitiveVariables:''';
-nextPutAll:(aClass primitiveVariablesString storeString copyFrom:2).
+	    nextPutAll:(aClass primitiveVariablesString storeString copyFrom:2).
 aStream nextPutChunkSeparator.
 "Modified: 9.11.1996 / 00:10:10 / cg"
 ! !
 "the primitiveSpec is either a string, or an integer specifying the
 position within the classes sourcefile ...
 "
 pos isNumber ifTrue:[
-classFilename notNil ifTrue:[
+	classFilename notNil ifTrue:[
-stream := self sourceStream.
+	    stream := self sourceStream.
-stream notNil ifTrue:[
+	    stream notNil ifTrue:[
-stream position:pos+1.
+		stream position:pos+1.
-string := stream nextChunk.
+		string := stream nextChunk.
-stream close.
+		stream close.
-^ string
+		^ string
-]
+	    ]
-].
+	].
-^ nil
+	^ nil
 ].
 ^ pos
 "Modified: 15.1.1997 / 15:29:30 / stefan"
 !
 self printOutDefinitionOn:aPrintStream.
 aPrintStream cr.
 collectionOfCategories := self class categories.
 collectionOfCategories notNil ifTrue:[
-aPrintStream nextPutLine:'class protocol'.
+	aPrintStream nextPutLine:'class protocol'.
-aPrintStream cr.
+	aPrintStream cr.
-collectionOfCategories do:[:aCategory |
+	collectionOfCategories do:[:aCategory |
-self class printOutCategoryProtocol:aCategory on:aPrintStream
+	    self class printOutCategoryProtocol:aCategory on:aPrintStream
-]
+	]
 ].
 collectionOfCategories := self categories.
 collectionOfCategories notNil ifTrue:[
-aPrintStream nextPutLine:'instance protocol'.
+	aPrintStream nextPutLine:'instance protocol'.
-aPrintStream cr.
+	aPrintStream cr.
-collectionOfCategories do:[:aCategory |
+	collectionOfCategories do:[:aCategory |
-self printOutCategoryProtocol:aCategory on:aPrintStream
+	    self printOutCategoryProtocol:aCategory on:aPrintStream
-]
+	]
 ]
 "Modified: 9.11.1996 / 00:14:26 / cg"
 ! !
 |set|
 set := IdentitySet new.
 Smalltalk allBehaviorsDo:[:aClass |
-aClass superclass isNil ifTrue:[set add:aClass]
+	aClass superclass isNil ifTrue:[set add:aClass]
 ].
 ^ set asOrderedCollection
 "
 Class rootsOfTheWorld
 Returns the new private class."
 |sel newClass|
 self owningClass notNil ifTrue:[
-^ self
+	^ self
 ].
 sel := self definitionSelectorPrivate.
 newClass := self superclass
-perform:sel
+	perform:sel
-withArguments:(Array
+	withArguments:(Array
-with:(self name asSymbol)
+			with:(self name asSymbol)
-with:(self instanceVariableString)
+			with:(self instanceVariableString)
-with:(self classVariableString)
+			with:(self classVariableString)
-with:''
+			with:''
-with:newOwner).
+			with:newOwner).
 "/ copy over methods ...
 self class copyInvalidatedMethodsFrom:self class for:newClass class.
 self class copyInvalidatedMethodsFrom:self for:newClass.
 newClass class recompileInvalidatedMethods.
 "/ first, create the public class ...
 sel := self definitionSelector.
 Class nameSpaceQuerySignal answer:Smalltalk
 do:[
-newClass := self superclass
+	newClass := self superclass
-perform:sel
+	    perform:sel
-withArguments:(Array
+	    withArguments:(Array
-with:(self nameWithoutPrefix asSymbol)
+			    with:(self nameWithoutPrefix asSymbol)
-with:(self instanceVariableString)
+			    with:(self instanceVariableString)
-with:(self classVariableString)
+			    with:(self classVariableString)
-with:''
+			    with:''
-with:(owner category)).
+			    with:(owner category)).
-"/ copy over methods ...
+	"/ copy over methods ...
-self class copyInvalidatedMethodsFrom:self class for:newClass class.
+	self class copyInvalidatedMethodsFrom:self class for:newClass class.
-self class copyInvalidatedMethodsFrom:self for:newClass.
+	self class copyInvalidatedMethodsFrom:self for:newClass.
-newClass class recompileInvalidatedMethods.
+	newClass class recompileInvalidatedMethods.
-newClass recompileInvalidatedMethods.
+	newClass recompileInvalidatedMethods.
 ].
 owner changed:#newClass with:newClass.
 Smalltalk changed:#newClass with:newClass.
 |owner 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.
+	    info := Class revisionInfoFromString:revision.
-info isNil ifTrue:[^ '0'].
+	    info isNil ifTrue:[^ '0'].
-^ info at:#revision ifAbsent:'0'.
+	    ^ info at:#revision ifAbsent:'0'.
-].
+	].
-c isDigit ifFalse:[
+	c isDigit ifFalse:[
-^ '0'
+	    ^ '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: 7.12.1995 / 10:58:47 / cg"
 "Modified: 1.4.1997 / 23:33:01 / stefan"
 !
 localSourceStreamFor:sourceFile
 "return an open stream on a local sourcefile, nil if that is not available"
-|fileName info module dir fn|
+|fileName info module dir fn package|
 "/
 "/ old: look in 'source/<filename>'
 "/ this is still kept in order to find user-private
 "/ classes in her currentDirectory.
 "/
 fileName := Smalltalk getSourceFileName:sourceFile.
 fileName notNil ifTrue:[
-^ fileName asFilename readStream.
+	^ fileName asFilename readStream.
+].
+(package := self package) notNil ifTrue:[
+	(package includes:$:) ifTrue:[
+	    package := package asString copy replaceAll:$: with:$/
+	] ifFalse:[
+	    package := 'stx/' , package
+	].
+	fileName := Smalltalk getSourceFileName:(package , '/' , sourceFile).
+	fileName notNil ifTrue:[
+	    ^ fileName asFilename readStream.
+	].
 ].
 "/
 "/ new: look in 'source/<module>/<package>/<filename>
 "/ this makes the symbolic links to (or copy of) the source files
 	module := info at:#module ifAbsent:nil.
 	module notNil ifTrue:[
 	    dir := info at:#directory ifAbsent:nil.
 	    dir notNil ifTrue:[
 		fn := (module asFilename construct:dir) construct:sourceFile.
-	        fileName := Smalltalk getSourceFileName:(fn name).
+		fileName := Smalltalk getSourceFileName:(fn name).
-fileName notNil ifTrue:[
+		fileName notNil ifTrue:[
-^ fileName asFilename readStream.
+		    ^ fileName asFilename readStream.
-].
+		].
 	    ]
 	]
 ].
 ^ nil
+"Modified: / 9.1.1998 / 15:02:46 / cg"
 !
 packageSourceCodeInfo
 "{ Pragma: +optSpace }"
 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
-'....(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 dirComponents mgr|
 package isNil 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:[
 "/        moduleString := 'stx'.
 "/        directoryString := libraryString := ''.
-^ nil
+	^ nil
 ].
 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 concreteClass components:(components at:1).
+	dirComponents := Filename concreteClass components:(components at:1).
-(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:[
-moduleString := 'stx'.
+	    moduleString := 'stx'.
-directoryString := libraryString := components at:1.
+	    directoryString := libraryString := components at:1.
-].
+	].
-(libraryString includes:$/) ifTrue:[
+	(libraryString includes:$/) ifTrue:[
-libraryString := libraryString asFilename baseName
+	    libraryString := libraryString asFilename baseName
-]
+	]
 ] ifFalse:[
-components size == 2 ifTrue:[
+	components size == 2 ifTrue:[
-"/ two components - assume its the module and the directory;
+	    "/ two components - assume its the module and the directory;
-"/ the library is assumed to be named after the directory
+	    "/ the library is assumed to be named after the directory
-"/ except, if slashes are in the name; then the libraryname
+	    "/ except, if slashes are in the name; then the libraryname
-"/ is the last component.
+	    "/ is the last component.
-"/
+	    "/
-moduleString := components at:1.
+	    moduleString := components at:1.
-directoryString := libraryString := components at:2.
+	    directoryString := libraryString := components at:2.
-(libraryString includes:$/) ifTrue:[
+	    (libraryString includes:$/) ifTrue:[
-libraryString := libraryString asFilename baseName
+		libraryString := libraryString asFilename baseName
-]
+	    ]
-] ifFalse:[
+	] ifFalse:[
-"/ all components given
+	    "/ all components given
-moduleString := components at:1.
+	    moduleString := components at:1.
-directoryString := components at:2.
+	    directoryString := components at:2.
-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
 |info|
 info := self revisionInfo.
 info notNil ifTrue:[
-^ info at:#revision ifAbsent:nil
+	^ info at:#revision ifAbsent:nil
 ].
 ^ self binaryRevision
 "
 Object revision
 |info|
 info := self revisionInfo.
 info notNil ifTrue:[
-^ info at:#date ifAbsent:'??/??/??'
+	^ info at:#date ifAbsent:'??/??/??'
 ].
 ^ '??/??/??'
 "
 Object revisionDateString
 revisionInfo
 "return a dictionary 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
+	#binaryRevision - the revision upon which the binary of this class is based
-#revision       - the revision upon which the class is based logically
+	#revision       - the revision upon which the class is based logically
-(different, if a changed class was checked in, but not yet recompiled)
+			  (different, if a changed class was checked in, but not yet recompiled)
-#user           - the user who checked in the logical revision
+	#user           - the user who checked in the logical revision
-#date           - the date when the logical revision was checked in
+	#date           - the date when the logical revision was checked in
-#time           - the time when the logical revision was checked in
+	#time           - the time when the logical revision was checked in
-#fileName       - the classes source file name
+	#fileName       - the classes source file name
-#repositoryPath - the classes source container
+	#repositoryPath - the classes source container
 "
 |vsnString info mgr|
 vsnString := self revisionString.
 vsnString notNil ifTrue:[
-mgr := self sourceCodeManager.
+	mgr := self sourceCodeManager.
-mgr notNil ifTrue:[
+	mgr notNil ifTrue:[
-info := mgr revisionInfoFromString:vsnString
+	    info := mgr revisionInfoFromString:vsnString
-] ifFalse:[
+	] ifFalse:[
-info := Class revisionInfoFromString:vsnString.
+	    info := Class revisionInfoFromString:vsnString.
-].
+	].
-info notNil ifTrue:[
+	info notNil ifTrue:[
-info at:#binaryRevision put:self binaryRevision.
+	    info at:#binaryRevision put:self binaryRevision.
-]
+	]
 ].
 ^ info
 "
 Object revisionString
 (owner := self owningClass) notNil ifTrue:[^ owner revisionString].
 thisContext isRecursive ifTrue:[^ nil ].
 self isMeta ifTrue:[
-meta := self. cls := self soleInstance
+	meta := self. cls := self soleInstance
 ] ifFalse:[
-cls := self. meta := self class
+	cls := self. meta := self class
 ].
 m := meta compiledMethodAt:#version.
 m isNil ifTrue:[
-m := cls compiledMethodAt:#version.
+	m := cls compiledMethodAt:#version.
-m isNil ifTrue:[^ nil].
+	m isNil ifTrue:[^ nil].
 ].
 m isExecutable ifTrue:[
-"/
+	"/
-"/ if its a method returning the string,
+	"/ if its a method returning the string,
-"/ thats the returned value
+	"/ thats the returned value
-"/
+	"/
-val := cls version.
+	val := cls version.
-val isString ifTrue:[^ val].
+	val isString ifTrue:[^ val].
 ].
 "/
 "/ if its a method consisting of a comment only
 "/ extract it - this may lead to a recursive call
 src isNil ifTrue:[^ nil].
 ^ Class revisionStringFromSource:src
 "
 Smalltalk allClassesDo:[:cls |
-Transcript showCR:cls revisionString
+	Transcript showCR:cls revisionString
 ].
 Number revisionString
 FileDirectory revisionString
 Metaclass revisionString
 self owningClass notNil ifTrue:[^ self].
 mgr := self sourceCodeManager.
 mgr notNil ifTrue:[
-info := mgr sourceInfoOfClass:self
+	info := mgr sourceInfoOfClass:self
 ].
 info notNil ifTrue:[
-mod := info at:#module ifAbsent:nil.    "/ stx, aeg, <your-organization>
+	mod := info at:#module ifAbsent:nil.    "/ stx, aeg, <your-organization>
-dir := info at:#directory ifAbsent:nil. "/ libbasic, libtool ...
+	dir := info at:#directory ifAbsent:nil. "/ libbasic, libtool ...
-lib := info at:#library ifAbsent:dir.
+	lib := info at:#library ifAbsent:dir.
-p := ''.
+	p := ''.
-mod notNil ifTrue:[
+	mod notNil ifTrue:[
-mod ~= 'stx' ifTrue:[
+	    mod ~= 'stx' ifTrue:[
-p := p , mod
+		p := p , mod
-]
+	    ]
-].
+	].
-dir notNil ifTrue:[
+	dir notNil ifTrue:[
-p notEmpty ifTrue:[p := p , ':'].
+	    p notEmpty ifTrue:[p := p , ':'].
-p := p , dir.
+	    p := p , dir.
-].
+	].
-lib notNil ifTrue:[
+	lib notNil ifTrue:[
-lib ~= dir ifTrue:[
+	    lib ~= dir ifTrue:[
-p notEmpty ifTrue:[p := p , ':'].
+		p notEmpty ifTrue:[p := p , ':'].
-p := p , lib.
+		p := p , lib.
-]
+	    ]
-].
+	].
-(p notEmpty and:[p ~= package]) ifTrue:[
+	(p notEmpty and:[p ~= package]) ifTrue:[
 "/            package notNil ifTrue:[
 "/                (name , ': changing packageID from ''' , package , ''' to ''' , p , '''') infoPrintCR.
 "/            ].
-package := p.
+	    package := p.
-self methodDictionary do:[:aMethod |
+	    self methodDictionary do:[:aMethod |
-aMethod package isNil ifTrue:[
+		aMethod package isNil ifTrue:[
-aMethod package:p
+		    aMethod package:p
-]
+		]
-]
+	    ]
-].
+	].
 ].
 ^ self
 "
 MemoryMonitor autoload.
 |owner source|
 (owner := self owningClass) notNil ifTrue:[^ owner sourceStream].
 classFilename notNil ifTrue:[
-source := classFilename
+	source := classFilename
 ] ifFalse:[
-source := (Smalltalk fileNameForClass:self) , '.st'
+	source := (Smalltalk fileNameForClass:self) , '.st'
 ].
 ^ self sourceStreamFor:source
 "Modified: 15.10.1996 / 18:59:40 / cg"
 "Modified: 1.4.1997 / 14:33:12 / stefan"
 or:[TryLocalSourceFirst == true]) ifTrue:[
 	aStream := self localSourceStreamFor:source.
 ].
 aStream 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|
-aStream isNil ifTrue:[
+		aStream isNil ifTrue:[
-(classes := h classes) notNil ifTrue:[
+		    (classes := h classes) notNil 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:[
-aStream := f readStream.
+				aStream := f readStream.
-].
+			    ].
-].
+			].
-].
+		    ].
-]
+		]
-].
+	    ].
-].
+	].
 ].
 aStream 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
-mgr notNil ifTrue:[
+	mgr notNil ifTrue:[
-aStream := mgr getSourceStreamFor:self.
+	    aStream := mgr getSourceStreamFor:self.
-aStream notNil ifTrue:[
+	    aStream notNil ifTrue:[
-(self validateSourceStream:aStream) ifFalse:[
+		(self validateSourceStream:aStream) ifFalse:[
-('Class [info]: repositories source for `'
+		    ('Class [info]: repositories source for `'
-, (self isMeta ifTrue:[self soleInstance name]
+		     , (self isMeta ifTrue:[self soleInstance name]
-ifFalse:[name])
+				    ifFalse:[name])
-, ''' is invalid.') infoPrintCR.
+		     , ''' is invalid.') infoPrintCR.
-aStream close.
+		    aStream close.
-aStream := nil
+		    aStream := nil
-] ifTrue:[
+		] ifTrue:[
-validated := true.
+		    validated := true.
-].
+		].
-].
+	    ].
-aStream isNil ifTrue:[
+	    aStream isNil ifTrue:[
 		aStream := self localSourceStreamFor:source.
-].
+	    ].
-].
+	].
-"/
+	"/
-"/ final chance: try current directory
+	"/ final chance: try current directory
-"/
+	"/
-aStream isNil ifTrue:[
+	aStream isNil ifTrue:[
-aStream := source asFilename readStream.
+	    aStream := source asFilename readStream.
-].
+	].
 ].
 (aStream notNil and:[validated not]) ifTrue:[
-(self validateSourceStream:aStream) ifFalse:[
+	(self validateSourceStream:aStream) ifFalse:[
-('Class [warning]: source for ''' , self name , ''' is invalid. Take care.') errorPrintCR
+	    ('Class [warning]: source for ''' , self name , ''' is invalid. Take care.') errorPrintCR
-].
+	].
 ].
 ^ aStream
 "
 Object sourceStream
 |cls "vs m mgr"|
 cls := self.
 self isMeta ifFalse:[
-cls := self class
+	cls := self class
 ].
 "/    m := cls compiledMethodAt:#version.
 "/    m isNil ifTrue:[^ false].
 "/    vs := self revisionString.
 "/    (mgr := self sourceCodeManager) isNil ifTrue:[^ false].
 "/    newString := mgr updatedRevisionStringOf:cls forRevision:newRevision with:vs.
 "/    newString isNil ifTrue:[^ false].
 MethodRedefinitionSignal handle:[:ex |
-ex proceedWith:#keep
+	ex proceedWith:#keep
 ] do:[
-Class withoutUpdatingChangesDo:[
+	Class withoutUpdatingChangesDo:[
-Compiler compile:'version
+	    Compiler compile:'version
 ^ ''' , newRevisionString , '''
 '
-forClass:cls
+		     forClass:cls
-inCategory:#documentation
+		     inCategory:#documentation
-notifying:nil
+		     notifying:nil
-install:true
+		     install:true
-skipIfSame:false
+		     skipIfSame:false
-silent:true.
+		     silent:true.
-]
+	]
 ].
 "/ ('updated to :' , newRevisionString) printNL.
 ^ true
 |cls meta cannotCheckReason versionMethod info
 versionFromCode versionFromSource oldPos pos src rev|
 self isMeta ifTrue:[
-meta := self. cls := self soleInstance
+	meta := self. cls := self soleInstance
 ] ifFalse:[
-cls := self. meta := self class
+	cls := self. meta := self class
 ].
 cannotCheckReason := nil.
 versionMethod := meta compiledMethodAt:#version.
 (versionMethod isNil
 or:[versionMethod isExecutable not]) ifTrue:[
-versionMethod := cls compiledMethodAt:#version.
+	versionMethod := cls compiledMethodAt:#version.
-(versionMethod isNil
+	(versionMethod isNil
-or:[versionMethod isExecutable not]) ifTrue:[
+	or:[versionMethod isExecutable not]) ifTrue:[
-cannotCheckReason := 'no valid version method'.
+	    cannotCheckReason := 'no valid version method'.
-]
+	]
 ] ifFalse:[
-"/
+	"/
-"/ if its a method returning the string,
+	"/ if its a method returning the string,
-"/ thats the returned value
+	"/ thats the returned value
-"/
+	"/
-versionFromCode := cls version.
+	versionFromCode := cls version.
-versionFromCode isString ifFalse:[
+	versionFromCode isString ifFalse:[
-cannotCheckReason := 'version method does not return a string'
+	    cannotCheckReason := 'version method does not return a string'
-].
+	].
 ].
 "/
 "/ if its a method consisting of a comment only
 "/ extract it - this may lead to a recursive call
 "/ to myself (thats what the #isRecursive is for)
 "/ in case we need to access the source code manager
 "/ for the source ...
 "/
 versionMethod notNil ifTrue:[
-pos := versionMethod sourcePosition.
+	pos := versionMethod sourcePosition.
-pos isInteger ifFalse:[
+	pos isInteger ifFalse:[
-"/ mhmh - either no version method,
+	    "/ mhmh - either no version method,
-"/ or updated due to a checkin.
+	    "/ or updated due to a checkin.
-"/ in any case, this should be a good source.
+	    "/ in any case, this should be a good source.
-^ true.
+	    ^ true.
-"/ cannotCheckReason := 'no source position for version-method'
+	    "/ cannotCheckReason := 'no source position for version-method'
-]
+	]
 ].
 cannotCheckReason notNil ifTrue:[
-('Class [warning]: ' , cannotCheckReason) errorPrintCR.
+	('Class [warning]: ' , cannotCheckReason) errorPrintCR.
-'Class [info]: cannot validate source; trusting source' infoPrintCR.
+	'Class [info]: cannot validate source; trusting source' infoPrintCR.
-^ true
+	^ true
 ].
 oldPos := aStream position.
 aStream position:pos.
 src := aStream nextChunk.
 aStream position:oldPos.
 (src isNil or:[src isEmpty]) ifTrue:[
 "/ 'empty source for version-method' printCR.
-^ false
+	^ false
 ].
 versionFromSource := Class revisionStringFromSource:src.
 versionFromSource = versionFromCode ifTrue:[^ true].
 "/ mhmh - check my binary version ...
 info := Class revisionInfoFromString:versionFromSource.
 info notNil ifTrue:[
-rev := info at:#revision.
+	rev := info at:#revision.
-rev = self binaryRevision ifTrue:[^ true].
+	rev = self binaryRevision ifTrue:[^ true].
 ].
 ^ false
 "Modified: 13.4.1997 / 02:18:09 / cg"
 ! !
 ! !
 !Class class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.297 1997-10-28 20:06:50 cg Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.298 1998-01-12 13:23:21 cg Exp $'
 ! !

changeset 3165	b6bde90005a8
parent 3064	59c97d974936
child 3180	1c225dd8c5b2