diff -r 4f37ae9c8961 -r b6bde90005a8 Class.st --- a/Class.st Mon Jan 12 14:21:57 1998 +0100 +++ b/Class.st Mon Jan 12 14:23:21 1998 +0100 @@ -41,54 +41,54 @@ [Instance variables:] - name the classes name - - category the classes category - - classvars the names of the class variables - - comment the classes comment; either a string, - a number specifying the offset in classFilename, or nil - - subclasses cached collection of subclasses - (currently unused - but will be soon) - - classFilename the file (or nil) where the classes - sources are found - - package the package, in which the class was defined - (inserted by compilers) - - revision revision string - inserted by stc - - primitiveSpec describes primitiveIncludes, primitiveFunctions etc. - - environment cached environment (i.e. Smalltalk or a namespace) - of class - - signature the classes signature (used to detect obsolete - or changed classes with binaryStorage) - This is filled in lazy - i.e. upon the first signature query. - - hook reserved: a place to add additional attributes, - without a need to recompile all classes. - Currently unused. + name the classes name + + category the classes category + + classvars the names of the class variables + + comment the classes comment; either a string, + a number specifying the offset in classFilename, or nil + + subclasses cached collection of subclasses + (currently unused - but will be soon) + + classFilename the file (or nil) where the classes + sources are found + + package the package, in which the class was defined + (inserted by compilers) + + revision revision string - inserted by stc + + primitiveSpec describes primitiveIncludes, primitiveFunctions etc. + + environment cached environment (i.e. Smalltalk or a namespace) + of class + + signature the classes signature (used to detect obsolete + or changed classes with binaryStorage) + This is filled in lazy - i.e. upon the first signature query. + + hook reserved: a place to add additional attributes, + without a need to recompile all classes. + Currently unused. [Class variables:] - OldMethods if nonNil, this must be an IdentityDictionary, - which is filled with method->previousversionMethod - associations. Can be used for undo-last-method-change - Notice: this may fillup your memory over time. + OldMethods if nonNil, this must be an IdentityDictionary, + which is filled with method->previousversionMethod + associations. Can be used for undo-last-method-change + 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 " ! ! @@ -176,11 +176,11 @@ is kept locally, for later undo (or compare)." aBoolean ifTrue:[ - OldMethods isNil ifTrue:[ - OldMethods := IdentityDictionary new. - ] + OldMethods isNil ifTrue:[ + OldMethods := IdentityDictionary new. + ] ] ifFalse:[ - OldMethods := nil + OldMethods := nil ]. " @@ -247,7 +247,7 @@ all history is lost." OldMethods notNil ifTrue:[ - OldMethods := IdentityDictionary new + OldMethods := IdentityDictionary new ]. "Created: 7.11.1996 / 19:07:25 / cg" @@ -290,10 +290,10 @@ "/ mhmh - ask the default manager "/ (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[ - info := mgr revisionInfoFromString:aString. - info notNil ifTrue:[ - ^ info - ] + info := mgr revisionInfoFromString:aString. + info notNil ifTrue:[ + ^ info + ] ]. "/ @@ -304,47 +304,47 @@ words := aString asCollectionOfWords. words notEmpty ifTrue:[ - "/ - "/ supported formats: - "/ - "/ $-Header: pathName rev date time user state $ - "/ $-Revision: rev $ - "/ $-Id: fileName rev date time user state $ - "/ - - ((words at:1) = '$Header:') ifTrue:[ - nm := words at:2. - info at:#repositoryPathName put:nm. - (nm endsWith:',v') ifTrue:[ - nm := nm copyWithoutLast:2 - ]. - info at:#fileName put:nm asFilename baseName. - words size > 2 ifTrue:[ - (words at:3) = '$' ifFalse:[ - info at:#revision put:(words at:3). - (words at:4) = '$' ifFalse:[ - info at:#date put:(words at:4). - info at:#time put:(words at:5). - info at:#user put:(words at:6). - info at:#state put:(words at:7). - ] - ]. - ]. - ^ info - ]. - ((words at:1) = '$Revision:') ifTrue:[ - info at:#revision put:(words at:2). - ^ info - ]. - ((words at:1) = '$Id:') ifTrue:[ - info at:#fileName put:(words at:2). - info at:#revision put:(words at:3). - info at:#date put:(words at:4). - info at:#time put:(words at:5). - info at:#user put:(words at:6). - info at:#state put:(words at:7). - ^ info - ]. + "/ + "/ supported formats: + "/ + "/ $-Header: pathName rev date time user state $ + "/ $-Revision: rev $ + "/ $-Id: fileName rev date time user state $ + "/ + + ((words at:1) = '$Header:') ifTrue:[ + nm := words at:2. + info at:#repositoryPathName put:nm. + (nm endsWith:',v') ifTrue:[ + nm := nm copyWithoutLast:2 + ]. + info at:#fileName put:nm asFilename baseName. + words size > 2 ifTrue:[ + (words at:3) = '$' ifFalse:[ + info at:#revision put:(words at:3). + (words at:4) = '$' ifFalse:[ + info at:#date put:(words at:4). + info at:#time put:(words at:5). + info at:#user put:(words at:6). + info at:#state put:(words at:7). + ] + ]. + ]. + ^ info + ]. + ((words at:1) = '$Revision:') ifTrue:[ + info at:#revision put:(words at:2). + ^ info + ]. + ((words at:1) = '$Id:') ifTrue:[ + info at:#fileName put:(words at:2). + info at:#revision put:(words at:3). + info at:#date put:(words at:4). + info at:#time put:(words at:5). + info at:#user put:(words at:6). + info at:#state put:(words at:7). + ^ info + ]. ]. ^ nil @@ -362,17 +362,17 @@ lines := aMethodSourceString asCollectionOfLines. lines do:[:l | - |i| - - i := l indexOfSubCollection:'$Header: '. - i ~~ 0 ifTrue:[ - line := l copyFrom:i. - i := line lastIndexOf:$$. - i > 1 ifTrue:[ - line := line copyTo:i. - ]. - ^ line - ] + |i| + + i := l indexOfSubCollection:'$Header: '. + i ~~ 0 ifTrue:[ + line := l copyFrom:i. + i := line lastIndexOf:$$. + i > 1 ifTrue:[ + line := line copyTo:i. + ]. + ^ line + ] ]. ^ nil @@ -401,10 +401,10 @@ (which seem to have no category)" ^ self subclass:t - instanceVariableNames:f - classVariableNames:d - poolDictionaries:s - category:'ST/V classes' + instanceVariableNames:f + classVariableNames:d + poolDictionaries:s + category:'ST/V classes' "Modified: 5.1.1997 / 19:59:30 / cg" ! @@ -416,10 +416,10 @@ (which seem to have no category and no instvars)" ^ self variableByteSubclass:t - instanceVariableNames:'' - classVariableNames:d - poolDictionaries:s - category:'ST/V classes' + instanceVariableNames:'' + classVariableNames:d + poolDictionaries:s + category:'ST/V classes' "Modified: 5.1.1997 / 19:59:33 / cg" ! @@ -431,10 +431,10 @@ (which seem to have no category)" ^ self variableSubclass:t - instanceVariableNames:f - classVariableNames:d - poolDictionaries:s - category:'ST/V classes' + instanceVariableNames:f + classVariableNames:d + poolDictionaries:s + category:'ST/V classes' "Modified: 5.1.1997 / 19:59:36 / cg" ! ! @@ -526,10 +526,10 @@ d := IdentityDictionary new. self classVarNames do:[:nm | - |sym| - - sym := nm asSymbol. - d at:sym put:(self classVarAt:sym) + |sym| + + sym := nm asSymbol. + d at:sym put:(self classVarAt:sym) ]. ^ d @@ -606,31 +606,31 @@ |prevVarNames varNames any| (classvars = aString) ifFalse:[ - prevVarNames := self classVarNames. - classvars := aString. - varNames := self classVarNames. - - "new ones get initialized to nil; - - old ones are nilled and removed from Smalltalk" - any := false. - - varNames do:[:aName | - (prevVarNames includes:aName) ifFalse:[ - "a new one" - self classVarAt:aName put:nil. - any := true. - ] ifTrue:[ - prevVarNames remove:aName - ] - ]. - "left overs are gone" - prevVarNames do:[:aName | - self classVarAt:aName put:nil. - Smalltalk removeKey:(self name , ':' , aName) asSymbol. - ]. - any ifTrue:[ - Smalltalk changed:#classVariables with:self - ]. + prevVarNames := self classVarNames. + classvars := aString. + varNames := self classVarNames. + + "new ones get initialized to nil; + - old ones are nilled and removed from Smalltalk" + any := false. + + varNames do:[:aName | + (prevVarNames includes:aName) ifFalse:[ + "a new one" + self classVarAt:aName put:nil. + any := true. + ] ifTrue:[ + prevVarNames remove:aName + ] + ]. + "left overs are gone" + prevVarNames do:[:aName | + self classVarAt:aName put:nil. + Smalltalk removeKey:(self name , ':' , aName) asSymbol. + ]. + any ifTrue:[ + Smalltalk changed:#classVariables with:self + ]. ] "Modified: 2.4.1997 / 00:16:05 / stefan" @@ -727,13 +727,13 @@ idx := name lastIndexOf:$:. idx == 0 ifTrue:[ - environment := Smalltalk. - ^ Smalltalk + environment := Smalltalk. + ^ Smalltalk ]. (name at:idx-1) ~~ $: ifTrue:[ - environment := Smalltalk. - ^ Smalltalk + environment := Smalltalk. + ^ Smalltalk ]. nsName := name copyTo:(idx - 2). environment := Smalltalk at:nsName asSymbol. @@ -743,7 +743,7 @@ ! package - "return the package of the class" + "return the package-id of the class" |owner| @@ -854,23 +854,23 @@ myNamePrefix := myName , '::'. Smalltalk allBehaviorsDo:[:aClass | - |nm owner| - - aClass isBehavior ifTrue:[ - (owner := aClass owningClass) notNil ifTrue:[ + |nm owner| + + aClass isBehavior ifTrue:[ + (owner := aClass owningClass) notNil ifTrue:[ "/ owner == self ifTrue:[ "/ classes add:aClass. "/ ]. - nm := aClass name. - (nm startsWith:myNamePrefix) ifTrue:[ - "/ care for private-privateClasses - (nm indexOf:$: startingAt:myName size + 3) == 0 ifTrue:[ - classes add:aClass. - ] - ] - ] - ] + nm := aClass name. + (nm startsWith:myNamePrefix) ifTrue:[ + "/ care for private-privateClasses + (nm indexOf:$: startingAt:myName size + 3) == 0 ifTrue:[ + classes add:aClass. + ] + ] + ] + ] ]. ^ classes asSortedCollection:[:a :b | a name < b name]. @@ -892,8 +892,8 @@ nmSym := (self name , '::' , aClassNameStringOrSymbol) asSymbolIfInterned. nmSym isNil ifTrue:[ - "/ no such symbol - there cannot be a corresponding private class - ^ nil + "/ no such symbol - there cannot be a corresponding private class + ^ nil ]. ^ Smalltalk at:nmSym. @@ -921,7 +921,7 @@ 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. @@ -1078,22 +1078,22 @@ |nm| self wasAutoloaded ifFalse:[ - " - can it be done ? - (all of my methods must have a source) - " - self methodDictionary do:[:aMethod | - aMethod source isNil ifTrue:[^false]. - aMethod hasPrimitiveCode ifTrue:[^ false]. - ]. - self class methodDictionary do:[:aMethod | - aMethod source isNil ifTrue:[^false]. - aMethod hasPrimitiveCode ifTrue:[^ false]. - ]. + " + can it be done ? + (all of my methods must have a source) + " + self methodDictionary do:[:aMethod | + aMethod source isNil ifTrue:[^false]. + aMethod hasPrimitiveCode ifTrue:[^ false]. + ]. + self class methodDictionary do:[:aMethod | + aMethod source isNil ifTrue:[^false]. + aMethod hasPrimitiveCode ifTrue:[^ false]. + ]. ]. self allSubclassesDo:[:aClass | - aClass unload + aClass unload ]. Transcript showCR:'unloading ' , name , ' ...'. @@ -1124,9 +1124,9 @@ addGlobalsForBinaryStorageTo:globalDictionary " classPool == nil ifFalse: [ - classPool associationsDo: [:assoc| - globalDictionary at: assoc put: self - ] + classPool associationsDo: [:assoc| + globalDictionary at: assoc put: self + ] ] " @@ -1168,31 +1168,31 @@ formatID := manager nextObject. formatID isInteger ifFalse:[ "/ backward compatibilty - formatID := nil. - superclassName := formatID + formatID := nil. + superclassName := formatID ] ifTrue:[ - superclassName := manager nextObject. + superclassName := manager nextObject. ]. superclassSig := manager nextObject. superclassName notNil ifTrue:[ - superClass := Smalltalk at:superclassName ifAbsent:nil. - - superClass isNil ifTrue:[ - BinaryIOManager nonexistingClassSignal - raiseRequestWith:'non existent superclass (in binaryLoad)'. - ^ nil - ]. - - "/ ('loading superclass: ' , superclassName ) printNL. - superClass autoload. - superClass := Smalltalk at:superclassName. - - superclassSig ~= superClass signature ifTrue:[ - BinaryIOManager changedInstLayoutSignal - raiseRequestWith:'incompatible superclass (in binaryLoad)'. - ^ nil - ] + superClass := Smalltalk at:superclassName ifAbsent:nil. + + superClass isNil ifTrue:[ + BinaryIOManager nonexistingClassSignal + raiseRequestWith:'non existent superclass (in binaryLoad)'. + ^ nil + ]. + + "/ ('loading superclass: ' , superclassName ) printNL. + superClass autoload. + superClass := Smalltalk at:superclassName. + + superclassSig ~= superClass signature ifTrue:[ + BinaryIOManager changedInstLayoutSignal + raiseRequestWith:'incompatible superclass (in binaryLoad)'. + ^ nil + ] ]. name := manager nextObject. @@ -1207,12 +1207,12 @@ comment := manager nextObject. package := manager nextObject. formatID == 1 ifTrue:[ - rev := manager nextObject. - ownerName := manager nextObject. - ownerName notNil ifTrue:[ - name := name copyFrom:(ownerName size + 2 + 1). - owner := Smalltalk at:ownerName. - ] + rev := manager nextObject. + ownerName := manager nextObject. + ownerName notNil ifTrue:[ + name := name copyFrom:(ownerName size + 2 + 1). + owner := Smalltalk at:ownerName. + ] ]. "/ 'got superName:' print. superclassName printNL. @@ -1226,38 +1226,38 @@ "/ ('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 - in:environment - subclassOf:cls - instanceVariableNames:instvars - variable:false - words:false - pointers:true - classVariableNames:classvars - poolDictionaries:'' - category:category - comment:comment - changed:false - classInstanceVariableNames:classInstVars. + name:name asSymbol + in:environment + subclassOf:cls + instanceVariableNames:instvars + variable:false + words:false + pointers:true + classVariableNames:classvars + poolDictionaries:'' + category:category + comment:comment + changed:false + classInstanceVariableNames:classInstVars. newClass isNil ifTrue:[ - ^ nil. + ^ nil. ]. superClass isNil ifTrue:[ - newClass setSuperclass:nil. - newClass class setSuperclass:Class. + newClass setSuperclass:nil. + newClass class setSuperclass:Class. ]. "/ Transcript showCR:'loaded ' , name , ' in ' , environment name. @@ -1270,26 +1270,26 @@ methods := MethodDictionary binaryFullDefinitionFrom:stream manager:manager. formatID == 1 ifTrue:[ - "/ privateClasses - nPrivate := manager nextObject. - nPrivate timesRepeat:[ - Class nameSpaceQuerySignal - answer:newClass - do:[ - privateClass := manager nextObject - ] - ] + "/ privateClasses + nPrivate := manager nextObject. + nPrivate timesRepeat:[ + Class nameSpaceQuerySignal + answer:newClass + do:[ + 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. @@ -1337,11 +1337,11 @@ owner := self owningClass. superclass isNil ifTrue:[ - s := nil. - sig := 0. + s := nil. + sig := 0. ] ifFalse:[ - s := superclass name. - sig := superclass signature. + s := superclass name. + sig := superclass signature. ]. s storeBinaryOn:stream manager:manager. sig storeBinaryOn:stream manager:manager. @@ -1349,49 +1349,49 @@ 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. - owner name storeBinaryOn:stream manager:manager. + nil storeBinaryOn:stream manager:manager. + nil storeBinaryOn:stream manager:manager. + owner name storeBinaryOn:stream manager:manager. ] ifFalse:[ - package storeBinaryOn:stream manager:manager. - revision storeBinaryOn:stream manager:manager. - nil storeBinaryOn:stream manager:manager. + package storeBinaryOn:stream manager:manager. + revision storeBinaryOn:stream manager:manager. + nil storeBinaryOn:stream manager:manager. ]. "/ @@ -1407,9 +1407,9 @@ privateClasses := self privateClassesSorted. privateClasses size storeBinaryOn:stream manager:manager. privateClasses size > 0 ifTrue:[ - privateClasses do:[:aClass | - aClass storeBinaryClassOn:stream manager:manager - ] + privateClasses do:[:aClass | + aClass storeBinaryClassOn:stream manager:manager + ] ]. " @@ -1471,18 +1471,18 @@ 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 := sz + n - 1. + sz := varnames inject:0 into:[:sum :nm | sum + nm size]. + 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)] ]. " @@ -1512,7 +1512,7 @@ "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" @@ -1524,7 +1524,7 @@ "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" @@ -1538,13 +1538,13 @@ |rv| UpdateChangeFileQuerySignal raise ifTrue:[ - rv := aClass revision. - rv isNil ifTrue:[rv := '???']. - - self - writingChangeWithTimeStamp:false - perform:#addInfoRecord:to: - with:('checkin ' , aClass name , ' (' , rv , ')'). + rv := aClass revision. + rv isNil ifTrue:[rv := '???']. + + self + writingChangeWithTimeStamp:false + perform:#addInfoRecord:to: + with:('checkin ' , aClass name , ' (' , rv , ')'). ] "Created: 18.11.1995 / 17:04:58 / cg" @@ -1557,7 +1557,7 @@ "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" @@ -1569,10 +1569,10 @@ "append a container-was-removed-record to the changes file" UpdateChangeFileQuerySignal raise ifTrue:[ - self - writingChangeWithTimeStamp:false - perform:#addInfoRecord:to: - with:('removed source container of ' , aClass name). + self + writingChangeWithTimeStamp:false + perform:#addInfoRecord:to: + with:('removed source container of ' , aClass name). ] "Created: 11.9.1996 / 15:37:19 / cg" @@ -1585,10 +1585,10 @@ "append a class-was-filedOut-record to the changes file" UpdateChangeFileQuerySignal raise ifTrue:[ - self - writingChangeWithTimeStamp:false - perform:#addInfoRecord:to: - with:('fileOut ' , aClass name). + self + writingChangeWithTimeStamp:false + perform:#addInfoRecord:to: + with:('fileOut ' , aClass name). ] "Modified: 24.1.1997 / 19:12:14 / cg" @@ -1600,7 +1600,7 @@ "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" @@ -1612,7 +1612,7 @@ "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" @@ -1624,9 +1624,9 @@ "add a class-rename-record to the changes file" UpdateChangeFileQuerySignal raise ifTrue:[ - self writingChangeDo:[:aStream | - self addChangeRecordForClassRename:oldName to:newName to:aStream - ] + self writingChangeDo:[:aStream | + self addChangeRecordForClassRename:oldName to:newName to:aStream + ] ] "Modified: 24.1.1997 / 19:10:35 / cg" @@ -1638,10 +1638,10 @@ "add a primitiveDefinitions-record to the changes file" UpdateChangeFileQuerySignal raise ifTrue:[ - self writingChangePerform:#addChangeRecordForPrimitiveDefinitions:to: with:aClass. - Project notNil ifTrue:[ - Project addPrimitiveDefinitionsChangeFor:aClass - ] + self writingChangePerform:#addChangeRecordForPrimitiveDefinitions:to: with:aClass. + Project notNil ifTrue:[ + Project addPrimitiveDefinitionsChangeFor:aClass + ] ] "Modified: 20.1.1997 / 12:36:10 / cg" @@ -1653,10 +1653,10 @@ "add a primitiveFunctions-record to the changes file" UpdateChangeFileQuerySignal raise ifTrue:[ - self writingChangePerform:#addChangeRecordForPrimitiveFunctions:to: with:aClass. - Project notNil ifTrue:[ - Project addPrimitiveFunctionsChangeFor:aClass - ] + self writingChangePerform:#addChangeRecordForPrimitiveFunctions:to: with:aClass. + Project notNil ifTrue:[ + Project addPrimitiveFunctionsChangeFor:aClass + ] ] "Modified: 20.1.1997 / 12:36:13 / cg" @@ -1668,10 +1668,10 @@ "add a primitiveVariables-record to the changes file" UpdateChangeFileQuerySignal raise ifTrue:[ - self writingChangePerform:#addChangeRecordForPrimitiveVariables:to: with:aClass. - Project notNil ifTrue:[ - Project addPrimitiveVariablesChangeFor:aClass - ] + self writingChangePerform:#addChangeRecordForPrimitiveVariables:to: with:aClass. + Project notNil ifTrue:[ + Project addPrimitiveVariablesChangeFor:aClass + ] ] "Modified: 20.1.1997 / 12:36:16 / cg" @@ -1683,10 +1683,10 @@ "add a snapshot-record to the changes file" UpdateChangeFileQuerySignal raise ifTrue:[ - self - writingChangeWithTimeStamp:false - perform:#addInfoRecord:to: - with:('snapshot ' , aFileName). + self + writingChangeWithTimeStamp:false + perform:#addInfoRecord:to: + with:('snapshot ' , aFileName). ] "Modified: 24.1.1997 / 19:12:25 / cg" @@ -1698,7 +1698,7 @@ "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" @@ -1712,7 +1712,7 @@ |classes| (classes := self privateClasses) size > 0 ifTrue:[ - classes do:aBlock + classes do:aBlock ]. "Created: 26.10.1996 / 12:28:57 / cg" @@ -1773,65 +1773,65 @@ 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:[ - nsName := ns name. - (nsName includes:$:) ifTrue:[ - nsName := '''' , nsName , '''' - ]. + (ns notNil and:[ns ~~ Smalltalk]) ifTrue:[ + nsName := ns name. + (nsName includes:$:) ifTrue:[ + nsName := '''' , nsName , '''' + ]. "/ aStream nextPutLine:'"{ NameSpace: ' , nsName , ' }"'; cr. - aStream nextPutAll:'"{ NameSpace: '. - syntaxHilighting ifTrue:[aStream bold]. - aStream nextPutAll:nsName. - syntaxHilighting ifTrue:[aStream normal]. - aStream nextPutAll:' }"'; cr; cr. - ] + aStream nextPutAll:'"{ NameSpace: '. + syntaxHilighting ifTrue:[aStream bold]. + aStream nextPutAll:nsName. + syntaxHilighting ifTrue:[aStream normal]. + aStream nextPutAll:' }"'; cr; cr. + ] ]. "take care of nil-superclass" superclass isNil ifTrue:[ - s := 'nil' + s := 'nil' ] ifFalse:[ - fullName ifTrue:[ - s := superclass name - ] ifFalse:[ - (ns == superclass nameSpace - and:[superclass owningClass isNil]) ifTrue:[ - s := superclass nameWithoutPrefix - ] ifFalse:[ - "/ a very special (rare) situation: - "/ my superclass resides in another nameSpace, - "/ but there is something else named like this - "/ to be found in my nameSpace (or a private class) - - superName := superclass nameWithoutNameSpacePrefix asSymbol. - cls := self privateClassesAt:superName. - cls isNil ifTrue:[ - (topOwner := self topOwningClass) isNil ifTrue:[ - ns := self nameSpace. - ns notNil ifTrue:[ - cls := ns privateClassesAt:superName - ] ifFalse:[ - "/ self error:'unexpected nil namespace' - ] - ] ifFalse:[ - cls := topOwner nameSpace at:superName. - ] - ]. - (cls notNil and:[cls ~~ superclass]) ifTrue:[ - s := superclass nameSpace name , '::' , superName - ] ifFalse:[ - s := superName - ] - ] - ] + fullName ifTrue:[ + s := superclass name + ] ifFalse:[ + (ns == superclass nameSpace + and:[superclass owningClass isNil]) ifTrue:[ + s := superclass nameWithoutPrefix + ] ifFalse:[ + "/ a very special (rare) situation: + "/ my superclass resides in another nameSpace, + "/ but there is something else named like this + "/ to be found in my nameSpace (or a private class) + + superName := superclass nameWithoutNameSpacePrefix asSymbol. + cls := self privateClassesAt:superName. + cls isNil ifTrue:[ + (topOwner := self topOwningClass) isNil ifTrue:[ + ns := self nameSpace. + ns notNil ifTrue:[ + cls := ns privateClassesAt:superName + ] ifFalse:[ + "/ self error:'unexpected nil namespace' + ] + ] ifFalse:[ + cls := topOwner nameSpace at:superName. + ] + ]. + (cls notNil and:[cls ~~ superclass]) ifTrue:[ + s := superclass nameSpace name , '::' , superName + ] ifFalse:[ + s := superName + ] + ] + ] ]. syntaxHilighting ifTrue:[aStream bold]. @@ -1841,16 +1841,16 @@ self basicFileOutInstvarTypeKeywordOn:aStream. (fullName and:[owner isNil]) ifTrue:[ - aStream nextPutAll:'#'''. - syntaxHilighting ifTrue:[aStream bold]. - aStream nextPutAll:(self name). - syntaxHilighting ifTrue:[aStream normal]. - aStream nextPutAll:''''. + aStream nextPutAll:'#'''. + syntaxHilighting ifTrue:[aStream bold]. + aStream nextPutAll:(self name). + syntaxHilighting ifTrue:[aStream normal]. + aStream nextPutAll:''''. ] ifFalse:[ - aStream nextPut:$#. - syntaxHilighting ifTrue:[aStream bold]. - aStream nextPutAll:(self nameWithoutPrefix). - syntaxHilighting ifTrue:[aStream normal]. + aStream nextPut:$#. + syntaxHilighting ifTrue:[aStream bold]. + aStream nextPutAll:(self nameWithoutPrefix). + syntaxHilighting ifTrue:[aStream normal]. ]. aStream crtab. @@ -1872,25 +1872,25 @@ aStream crtab. owner isNil ifTrue:[ - "/ a public class - aStream nextPutAll:'category:'. - category isNil ifTrue:[ - s := '''''' - ] ifFalse:[ - s := category asString storeString - ]. - aStream nextPutAll:s. + "/ a public class + aStream nextPutAll:'category:'. + category isNil ifTrue:[ + s := '''''' + ] ifFalse:[ + s := category asString storeString + ]. + aStream nextPutAll:s. ] ifFalse:[ - "/ a private class - aStream nextPutAll:'privateIn:'. - syntaxHilighting ifTrue:[aStream bold]. - fullName ifTrue:[ - s := owner name. - ] ifFalse:[ - s := owner nameWithoutNameSpacePrefix. - ]. - aStream nextPutAll:s. - syntaxHilighting ifTrue:[aStream normal]. + "/ a private class + aStream nextPutAll:'privateIn:'. + syntaxHilighting ifTrue:[aStream bold]. + fullName ifTrue:[ + s := owner name. + ] ifFalse:[ + s := owner nameWithoutNameSpacePrefix. + ]. + aStream nextPutAll:s. + syntaxHilighting ifTrue:[aStream normal]. ]. aStream cr @@ -1904,44 +1904,44 @@ |isVar s| superclass isNil ifTrue:[ - isVar := self isVariable + isVar := self isVariable ] ifFalse:[ - "I cant remember what this is for ?" - isVar := (self isVariable and:[superclass isVariable not]) + "I cant remember what this is for ?" + isVar := (self isVariable and:[superclass isVariable not]) ]. isVar ifTrue:[ - self isBytes ifTrue:[ - s := 'variableByteSubclass:' - ] ifFalse:[ - self isWords ifTrue:[ - s := 'variableWordSubclass:' - ] ifFalse:[ - self isLongs ifTrue:[ - s := 'variableLongSubclass:' - ] ifFalse:[ - self isFloats ifTrue:[ - s := 'variableFloatSubclass:' - ] ifFalse:[ - self isDoubles ifTrue:[ - s := 'variableDoubleSubclass:' - ] ifFalse:[ - self isSignedWords ifTrue:[ - s := 'variableSignedWordSubclass:' - ] ifFalse:[ - self isSignedLongs ifTrue:[ - s := 'variableSignedLongSubclass:' - ] ifFalse:[ - s := 'variableSubclass:' - ] - ] - ] - ] - ] - ] - ] + self isBytes ifTrue:[ + s := 'variableByteSubclass:' + ] ifFalse:[ + self isWords ifTrue:[ + s := 'variableWordSubclass:' + ] ifFalse:[ + self isLongs ifTrue:[ + s := 'variableLongSubclass:' + ] ifFalse:[ + self isFloats ifTrue:[ + s := 'variableFloatSubclass:' + ] ifFalse:[ + self isDoubles ifTrue:[ + s := 'variableDoubleSubclass:' + ] ifFalse:[ + self isSignedWords ifTrue:[ + s := 'variableSignedWordSubclass:' + ] ifFalse:[ + self isSignedLongs ifTrue:[ + s := 'variableSignedLongSubclass:' + ] ifFalse:[ + s := 'variableSubclass:' + ] + ] + ] + ] + ] + ] + ] ] ifFalse:[ - s := 'subclass:' + s := 'subclass:' ]. aStream nextPutAll:s. @@ -1990,9 +1990,9 @@ "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 - #reference - include a reference to the sourceFile - #discard - dont save sources. + #keep - include the source + #reference - include a reference to the sourceFile + #discard - dont save sources. With #reference, the sourceFile needs to be present after reload in order to be browsable." @@ -2003,17 +2003,17 @@ 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 - raiseRequestWith:fileName - errorString:('cannot create file:', fileName) + ^ FileOutErrorSignal + raiseRequestWith:fileName + errorString:('cannot create file:', fileName) ]. aStream binary. @@ -2041,9 +2041,9 @@ 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. @@ -2072,13 +2072,13 @@ "/ optional classInstanceVariables "/ self class instanceVariableString isBlank ifFalse:[ - self fileOutClassInstVarDefinitionOn:aStream. - aStream nextPutChunkSeparator. - aStream cr; cr + self fileOutClassInstVarDefinitionOn:aStream. + aStream nextPutChunkSeparator. + aStream cr; cr ]. self privateClassesSorted do:[:aClass | - aClass fileOutAllDefinitionsOn:aStream + aClass fileOutAllDefinitionsOn:aStream ] "Created: 15.10.1996 / 11:15:19 / cg" @@ -2090,21 +2090,21 @@ collectionOfCategories := self class categories asSortedCollection. collectionOfCategories notNil ifTrue:[ - collectionOfCategories do:[:aCategory | - self class fileOutCategory:aCategory on:aStream. - aStream cr - ] + collectionOfCategories do:[:aCategory | + self class fileOutCategory:aCategory on:aStream. + aStream cr + ] ]. collectionOfCategories := self categories asSortedCollection. collectionOfCategories notNil ifTrue:[ - collectionOfCategories do:[:aCategory | - self fileOutCategory:aCategory on:aStream. - aStream cr - ] + collectionOfCategories do:[:aCategory | + self fileOutCategory:aCategory on:aStream. + aStream cr + ] ]. self privateClassesSorted do:[:aClass | - aClass fileOutAllMethodsOn:aStream + aClass fileOutAllMethodsOn:aStream ]. "Created: 15.10.1996 / 11:13:00 / cg" @@ -2132,62 +2132,62 @@ and, if that worked rename afterwards ... " (fileName exists) ifTrue:[ - sameFile := false. - - "/ check carefully - maybe, my source does not really come from that - "/ file (i.e. all of my methods have their source as string) - - anySourceRef := false. - self methodDictionary do:[:m| - m sourcePosition notNil ifTrue:[ - anySourceRef := true - ] - ]. - self class methodDictionary do:[:m| - m sourcePosition notNil ifTrue:[ - anySourceRef := true - ] - ]. - - anySourceRef ifTrue:[ - s := self sourceStream. - s notNil ifTrue:[ - mySourceFileID := s pathName asFilename info id. - sameFile := (fileName info id) == mySourceFileID. - s close. - ] ifFalse:[ - classFilename notNil ifTrue:[ - " - check for overwriting my current source file - this is not allowed, since it would clobber my methods source - file ... you have to save it to some other place. - This happens if you ask for a fileOut into the source-directory - (from which my methods get their source) - " - mySourceFileName := Smalltalk getSourceFileName:classFilename. - sameFile := (fileNameString = mySourceFileName). - sameFile ifFalse:[ - mySourceFileName notNil ifTrue:[ - sameFile := (fileName info id) == (mySourceFileName asFilename info id) - ] - ]. - ] - ]. - ]. - - sameFile ifTrue:[ - ^ FileOutErrorSignal - raiseRequestWith:fileNameString - errorString:('may not overwrite sourcefile:', fileNameString) - ]. + sameFile := false. + + "/ check carefully - maybe, my source does not really come from that + "/ file (i.e. all of my methods have their source as string) + + anySourceRef := false. + self methodDictionary do:[:m| + m sourcePosition notNil ifTrue:[ + anySourceRef := true + ] + ]. + self class methodDictionary do:[:m| + m sourcePosition notNil ifTrue:[ + anySourceRef := true + ] + ]. + + anySourceRef ifTrue:[ + s := self sourceStream. + s notNil ifTrue:[ + mySourceFileID := s pathName asFilename info id. + sameFile := (fileName info id) == mySourceFileID. + s close. + ] ifFalse:[ + classFilename notNil ifTrue:[ + " + check for overwriting my current source file + this is not allowed, since it would clobber my methods source + file ... you have to save it to some other place. + This happens if you ask for a fileOut into the source-directory + (from which my methods get their source) + " + mySourceFileName := Smalltalk getSourceFileName:classFilename. + sameFile := (fileNameString = mySourceFileName). + sameFile ifFalse:[ + mySourceFileName notNil ifTrue:[ + sameFile := (fileName info id) == (mySourceFileName asFilename info id) + ] + ]. + ] + ]. + ]. + + sameFile ifTrue:[ + ^ FileOutErrorSignal + raiseRequestWith:fileNameString + errorString:('may not overwrite sourcefile:', fileNameString) + ]. savFilename := Filename newTemporary. - fileName copyTo:savFilename. - newFileName := fileName withSuffix:'new'. - needRename := true + fileName copyTo:savFilename. + newFileName := fileName withSuffix:'new'. + needRename := true ] ifFalse:[ - newFileName := fileName. - needRename := false + newFileName := fileName. + needRename := false ]. aStream := newFileName writeStream. @@ -2195,9 +2195,9 @@ savFilename notNil ifTrue:[ savFilename delete ]. - ^ FileOutErrorSignal - raiseRequestWith:newFileName - errorString:('cannot create file:', newFileName name) + ^ FileOutErrorSignal + raiseRequestWith:newFileName + errorString:('cannot create file:', newFileName name) ]. self fileOutOn:aStream. aStream close. @@ -2208,8 +2208,8 @@ we have to do a copy ... " needRename ifTrue:[ - newFileName copyTo:fileName. - newFileName delete + newFileName copyTo:fileName. + newFileName delete ]. savFilename notNil ifTrue:[ savFilename delete @@ -2239,11 +2239,11 @@ aStream cr; cr; nextPut:(Character doubleQuote); cr. aStream space; - nextPutLine:'The following class instance variables are inherited by this class:'; - cr. + nextPutLine:'The following class instance variables are inherited by this class:'; + cr. self allSuperclassesDo:[:aSuperClass | - aStream tab; nextPutAll:aSuperClass name; nextPutAll:' - '. - aStream nextPutLine:(aSuperClass class instanceVariableString). + aStream tab; nextPutAll:aSuperClass name; nextPutAll:' - '. + aStream nextPutLine:(aSuperClass class instanceVariableString). ]. aStream nextPut:(Character doubleQuote); cr. @@ -2260,9 +2260,9 @@ 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. @@ -2290,16 +2290,16 @@ fileName := (Smalltalk fileNameForClass:self name), '.st'. aStream := (aDirectoryName asFilename construct:fileName) writeStream. aStream isNil ifTrue:[ - ^ FileOutErrorSignal - raiseRequestWith:fileName - errorString:('cannot create file:', fileName) + ^ FileOutErrorSignal + raiseRequestWith:fileName + errorString:('cannot create file:', fileName) ]. self fileOutOn:aStream. aStream close " - self fileOutIn:'/tmp' - self fileOutIn:'/tmp' asFilename + self fileOutIn:'/tmp' + self fileOutIn:'/tmp' asFilename " "Modified: 19.9.1997 / 00:03:53 / stefan" @@ -2321,9 +2321,9 @@ meta| self isLoaded ifFalse:[ - ^ FileOutErrorSignal - raiseRequestWith:self - errorString:'will not fileOut unloaded classes' + ^ FileOutErrorSignal + raiseRequestWith:self + errorString:'will not fileOut unloaded classes' ]. meta := self class. @@ -2338,36 +2338,36 @@ code was edited in the browser and filedOut. " (copyrightMethod := meta compiledMethodAt:#copyright) notNil ifTrue:[ - " - get the copyright methods source, - and insert at beginning. - " - copyrightText := copyrightMethod source. - copyrightText isNil ifTrue:[ - " - no source available - trigger an error - " - FileOutErrorSignal - raiseRequestWith:'no source for class ' , self name , ' available. Cannot fileOut'. - ^ self - ]. - " - strip off the selector-line - " - copyrightText := copyrightText asCollectionOfLines asStringCollection. - copyrightText := copyrightText copyFrom:2 to:(copyrightText size). + " + get the copyright methods source, + and insert at beginning. + " + copyrightText := copyrightMethod source. + copyrightText isNil ifTrue:[ + " + no source available - trigger an error + " + FileOutErrorSignal + raiseRequestWith:'no source for class ' , self name , ' available. Cannot fileOut'. + ^ self + ]. + " + strip off the selector-line + " + copyrightText := copyrightText asCollectionOfLines asStringCollection. + copyrightText := copyrightText copyFrom:2 to:(copyrightText size). "/ copyrightText do:[:line | aStream nextPutAll:line. aStream cr.]. - copyrightText := copyrightText asString. - aStream nextPutAllAsChunk:copyrightText. + copyrightText := copyrightText asString. + aStream nextPutAllAsChunk:copyrightText. ]. stampIt ifTrue:[ - "/ - "/ first, a timestamp - "/ - aStream nextPutAll:(Smalltalk timeStamp). - aStream nextPutChunkSeparator. - aStream cr; cr. + "/ + "/ first, a timestamp + "/ + aStream nextPutAll:(Smalltalk timeStamp). + aStream nextPutChunkSeparator. + aStream cr; cr. ]. "/ @@ -2379,8 +2379,8 @@ "/ a comment - if any "/ (comment := self comment) notNil ifTrue:[ - self fileOutCommentOn:aStream. - aStream cr. + self fileOutCommentOn:aStream. + aStream cr. ]. "/ @@ -2396,41 +2396,41 @@ "/ collectionOfCategories := meta categories asSortedCollection. collectionOfCategories notNil ifTrue:[ - "/ - "/ documentation first (if any), but not the version method - "/ - (collectionOfCategories includes:'documentation') ifTrue:[ - versionMethod := meta compiledMethodAt:#version. - versionMethod notNil ifTrue:[ - skippedMethods := Array with:versionMethod - ]. - meta fileOutCategory:'documentation' except:skippedMethods only:nil on:aStream. - aStream cr. - ]. - - "/ - "/ initialization next (if any) - "/ - (collectionOfCategories includes:'initialization') ifTrue:[ - meta fileOutCategory:'initialization' on:aStream. - aStream cr. - ]. - - "/ - "/ instance creation next (if any) - "/ - (collectionOfCategories includes:'instance creation') ifTrue:[ - meta fileOutCategory:'instance creation' on:aStream. - aStream cr. - ]. - collectionOfCategories do:[:aCategory | - ((aCategory ~= 'documentation') - and:[(aCategory ~= 'initialization') - and:[aCategory ~= 'instance creation']]) ifTrue:[ - meta fileOutCategory:aCategory on:aStream. - aStream cr - ] - ] + "/ + "/ documentation first (if any), but not the version method + "/ + (collectionOfCategories includes:'documentation') ifTrue:[ + versionMethod := meta compiledMethodAt:#version. + versionMethod notNil ifTrue:[ + skippedMethods := Array with:versionMethod + ]. + meta fileOutCategory:'documentation' except:skippedMethods only:nil on:aStream. + aStream cr. + ]. + + "/ + "/ initialization next (if any) + "/ + (collectionOfCategories includes:'initialization') ifTrue:[ + meta fileOutCategory:'initialization' on:aStream. + aStream cr. + ]. + + "/ + "/ instance creation next (if any) + "/ + (collectionOfCategories includes:'instance creation') ifTrue:[ + meta fileOutCategory:'instance creation' on:aStream. + aStream cr. + ]. + collectionOfCategories do:[:aCategory | + ((aCategory ~= 'documentation') + and:[(aCategory ~= 'initialization') + and:[aCategory ~= 'instance creation']]) ifTrue:[ + meta fileOutCategory:aCategory on:aStream. + aStream cr + ] + ] ]. "/ @@ -2438,17 +2438,17 @@ "/ collectionOfCategories := self categories asSortedCollection. collectionOfCategories notNil ifTrue:[ - collectionOfCategories do:[:aCategory | - self fileOutCategory:aCategory on:aStream. - aStream cr - ] + collectionOfCategories do:[:aCategory | + self fileOutCategory:aCategory on:aStream. + aStream cr + ] ]. "/ "/ any private classes' methods "/ self privateClassesSorted do:[:aClass | - aClass fileOutAllMethodsOn:aStream + aClass fileOutAllMethodsOn:aStream ]. @@ -2456,16 +2456,16 @@ "/ 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'. - aStream nextPutChunkSeparator. - aStream cr + self printClassNameOn:aStream. aStream nextPutAll:' initialize'. + aStream nextPutChunkSeparator. + aStream cr ] "Created: 15.11.1995 / 12:53:06 / cg" @@ -2482,22 +2482,22 @@ primitive definitions - if any " (s := self primitiveDefinitionsString) notNil ifTrue:[ - aStream nextPutChunkSeparator. - self printClassNameOn:aStream. - aStream nextPutAll:' primitiveDefinitions'; - nextPutChunkSeparator; - cr. - aStream nextPutAll:s. - aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr + aStream nextPutChunkSeparator. + self printClassNameOn:aStream. + aStream nextPutAll:' primitiveDefinitions'; + nextPutChunkSeparator; + cr. + aStream nextPutAll:s. + aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr ]. (s := self primitiveVariablesString) notNil ifTrue:[ - aStream nextPutChunkSeparator. - self printClassNameOn:aStream. - aStream nextPutAll:' primitiveVariables'; - nextPutChunkSeparator; - cr. - aStream nextPutAll:s. - aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr + aStream nextPutChunkSeparator. + self printClassNameOn:aStream. + aStream nextPutAll:' primitiveVariables'; + nextPutChunkSeparator; + cr. + aStream nextPutAll:s. + aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr ]. "Modified: 8.1.1997 / 17:45:40 / cg" @@ -2516,13 +2516,13 @@ primitive functions - if any " (s := self primitiveFunctionsString) notNil ifTrue:[ - aStream nextPutChunkSeparator. - self printClassNameOn:aStream. - aStream nextPutAll:' primitiveFunctions'; - nextPutChunkSeparator; - cr. - aStream nextPutAll:s. - aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr + aStream nextPutChunkSeparator. + self printClassNameOn:aStream. + aStream nextPutAll:' primitiveFunctions'; + nextPutChunkSeparator; + cr. + aStream nextPutAll:s. + aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr ]. "Modified: 8.1.1997 / 17:45:51 / cg" @@ -2555,7 +2555,7 @@ 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| @@ -2573,25 +2573,25 @@ dict := self methodDictionary. dict notNil ifTrue:[ - any := false. - dict do:[:aMethod | - (aCategory = aMethod category) ifTrue:[ - any := true - ] - ]. - any ifTrue:[ - aPrintStream italic. - aPrintStream nextPutAll:aCategory. - aPrintStream normal. - aPrintStream cr; cr. - dict do:[:aMethod | - (aCategory = aMethod category) ifTrue:[ - self printOutSource:(aMethod source) on:aPrintStream. - aPrintStream cr; cr - ] - ]. - aPrintStream cr - ] + any := false. + dict do:[:aMethod | + (aCategory = aMethod category) ifTrue:[ + any := true + ] + ]. + any ifTrue:[ + aPrintStream italic. + aPrintStream nextPutAll:aCategory. + aPrintStream normal. + aPrintStream cr; cr. + dict do:[:aMethod | + (aCategory = aMethod category) ifTrue:[ + self printOutSource:(aMethod source) on:aPrintStream. + aPrintStream cr; cr + ] + ]. + aPrintStream cr + ] ] "Modified: 12.6.1996 / 11:47:36 / stefan" @@ -2605,9 +2605,9 @@ 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. @@ -2620,12 +2620,12 @@ aPrintStream cr. category notNil ifTrue:[ - aPrintStream nextPutAll:'category '; - nextPutLine:(category printString). + aPrintStream nextPutAll:'category '; + 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" @@ -2642,19 +2642,19 @@ aPrintStream cr. collectionOfCategories := self class categories. collectionOfCategories notNil ifTrue:[ - aPrintStream nextPutLine:'class protocol'. - aPrintStream cr. - collectionOfCategories do:[:aCategory | - self class printOutCategory:aCategory on:aPrintStream - ] + aPrintStream nextPutLine:'class protocol'. + aPrintStream cr. + collectionOfCategories do:[:aCategory | + self class printOutCategory:aCategory on:aPrintStream + ] ]. collectionOfCategories := self categories. collectionOfCategories notNil ifTrue:[ - aPrintStream nextPutLine:'instance protocol'. - aPrintStream cr. - collectionOfCategories do:[:aCategory | - self printOutCategory:aCategory on:aPrintStream - ] + aPrintStream nextPutLine:'instance protocol'. + aPrintStream cr. + collectionOfCategories do:[:aCategory | + self printOutCategory:aCategory on:aPrintStream + ] ] "Modified: 9.11.1996 / 00:14:11 / cg" @@ -2785,7 +2785,7 @@ "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" @@ -2797,7 +2797,7 @@ "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" @@ -2809,7 +2809,7 @@ "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" @@ -2834,16 +2834,16 @@ position within the classes sourcefile ... " pos isNumber ifTrue:[ - classFilename notNil ifTrue:[ - stream := self sourceStream. - stream notNil ifTrue:[ - stream position:pos+1. - string := stream nextChunk. - stream close. - ^ string - ] - ]. - ^ nil + classFilename notNil ifTrue:[ + stream := self sourceStream. + stream notNil ifTrue:[ + stream position:pos+1. + string := stream nextChunk. + stream close. + ^ string + ] + ]. + ^ nil ]. ^ pos @@ -2872,19 +2872,19 @@ aPrintStream cr. collectionOfCategories := self class categories. collectionOfCategories notNil ifTrue:[ - aPrintStream nextPutLine:'class protocol'. - aPrintStream cr. - collectionOfCategories do:[:aCategory | - self class printOutCategoryProtocol:aCategory on:aPrintStream - ] + aPrintStream nextPutLine:'class protocol'. + aPrintStream cr. + collectionOfCategories do:[:aCategory | + self class printOutCategoryProtocol:aCategory on:aPrintStream + ] ]. collectionOfCategories := self categories. collectionOfCategories notNil ifTrue:[ - aPrintStream nextPutLine:'instance protocol'. - aPrintStream cr. - collectionOfCategories do:[:aCategory | - self printOutCategoryProtocol:aCategory on:aPrintStream - ] + aPrintStream nextPutLine:'instance protocol'. + aPrintStream cr. + collectionOfCategories do:[:aCategory | + self printOutCategoryProtocol:aCategory on:aPrintStream + ] ] "Modified: 9.11.1996 / 00:14:26 / cg" @@ -2917,7 +2917,7 @@ set := IdentitySet new. Smalltalk allBehaviorsDo:[:aClass | - aClass superclass isNil ifTrue:[set add:aClass] + aClass superclass isNil ifTrue:[set add:aClass] ]. ^ set asOrderedCollection @@ -2970,19 +2970,19 @@ |sel newClass| self owningClass notNil ifTrue:[ - ^ self + ^ self ]. sel := self definitionSelectorPrivate. newClass := self superclass - perform:sel - withArguments:(Array - with:(self name asSymbol) - with:(self instanceVariableString) - with:(self classVariableString) - with:'' - with:newOwner). + perform:sel + withArguments:(Array + with:(self name asSymbol) + with:(self instanceVariableString) + with:(self classVariableString) + with:'' + with:newOwner). "/ copy over methods ... self class copyInvalidatedMethodsFrom:self class for:newClass class. @@ -3014,20 +3014,20 @@ Class nameSpaceQuerySignal answer:Smalltalk do:[ - newClass := self superclass - perform:sel - withArguments:(Array - with:(self nameWithoutPrefix asSymbol) - with:(self instanceVariableString) - with:(self classVariableString) - with:'' - with:(owner category)). - - "/ copy over methods ... - self class copyInvalidatedMethodsFrom:self class for:newClass class. - self class copyInvalidatedMethodsFrom:self for:newClass. - newClass class recompileInvalidatedMethods. - newClass recompileInvalidatedMethods. + newClass := self superclass + perform:sel + withArguments:(Array + with:(self nameWithoutPrefix asSymbol) + with:(self instanceVariableString) + with:(self classVariableString) + with:'' + with:(owner category)). + + "/ copy over methods ... + self class copyInvalidatedMethodsFrom:self class for:newClass class. + self class copyInvalidatedMethodsFrom:self for:newClass. + newClass class recompileInvalidatedMethods. + newClass recompileInvalidatedMethods. ]. owner changed:#newClass with:newClass. @@ -3172,15 +3172,15 @@ (owner := self owningClass) notNil ifTrue:[^ owner binaryRevision]. revision notNil ifTrue:[ - c := revision first. - c == $$ ifTrue:[ - info := Class revisionInfoFromString:revision. - info isNil ifTrue:[^ '0']. - ^ info at:#revision ifAbsent:'0'. - ]. - c isDigit ifFalse:[ - ^ '0' - ]. + c := revision first. + c == $$ ifTrue:[ + info := Class revisionInfoFromString:revision. + info isNil ifTrue:[^ '0']. + ^ info at:#revision ifAbsent:'0'. + ]. + c isDigit ifFalse:[ + ^ '0' + ]. ]. ^ revision @@ -3196,7 +3196,7 @@ |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' " @@ -3208,7 +3208,7 @@ 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/' @@ -3217,7 +3217,19 @@ "/ 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. + ]. ]. "/ @@ -3231,14 +3243,16 @@ dir := info at:#directory ifAbsent:nil. dir notNil ifTrue:[ fn := (module asFilename construct:dir) construct:sourceFile. - fileName := Smalltalk getSourceFileName:(fn name). - fileName notNil ifTrue:[ - ^ fileName asFilename readStream. - ]. + fileName := Smalltalk getSourceFileName:(fn name). + fileName notNil ifTrue:[ + ^ fileName asFilename readStream. + ]. ] ] ]. ^ nil + + "Modified: / 9.1.1998 / 15:02:46 / cg" ! packageSourceCodeInfo @@ -3268,10 +3282,10 @@ (this is done for backward compatibility,) For example: - '....(libbasic)' -> module: stx directory: libbasic library: libbasic - '....(stx:libbasic)' -> module: stx directory: libbasic library: libbasic - '....(aeg:libIECInterface)' -> module: aeg directory: libIECInterface library:libIECInterface - '....(stx:goodies/persistency:libdbase)' -> module: stx directory: goodies/persistency library:libdbase + '....(libbasic)' -> module: stx directory: libbasic library: libbasic + '....(stx:libbasic)' -> module: stx directory: libbasic library: libbasic + '....(aeg:libIECInterface)' -> module: aeg directory: libIECInterface library:libIECInterface + '....(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, @@ -3279,7 +3293,7 @@ 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 @@ -3292,12 +3306,12 @@ packageString := package asString. idx1 := packageString lastIndexOf:$(. idx1 ~~ 0 ifTrue:[ - idx2 := packageString indexOf:$) startingAt:idx1+1. - idx2 ~~ 0 ifTrue:[ - sourceInfo := packageString copyFrom:idx1 + 1 to:idx2 - 1 - ] + idx2 := packageString indexOf:$) startingAt:idx1+1. + idx2 ~~ 0 ifTrue:[ + sourceInfo := packageString copyFrom:idx1 + 1 to:idx2 - 1 + ] ] ifFalse:[ - sourceInfo := packageString + sourceInfo := packageString ]. sourceInfo isNil ifTrue:[^ nil]. @@ -3305,71 +3319,71 @@ components size == 0 ifTrue:[ "/ moduleString := 'stx'. "/ directoryString := libraryString := ''. - ^ nil + ^ nil ]. components size == 1 ifTrue:[ - "/ a single name given - the module becomes 'stx' or - "/ the very first directory component (if such a module exists). - "/ If the component includes slashes, its the directory - "/ otherwise the library - "/ - dirComponents := Filename concreteClass components:(components at:1). - - (dirComponents size > 1 - and:[(mgr := self sourceCodeManager) notNil - and:[mgr checkForExistingModule:dirComponents first]]) ifTrue:[ - moduleString := dirComponents first. - directoryString := libraryString := (Filename fromComponents:(dirComponents copyFrom:2)) asString. - ] ifFalse:[ - moduleString := 'stx'. - directoryString := libraryString := components at:1. - ]. - - (libraryString includes:$/) ifTrue:[ - libraryString := libraryString asFilename baseName - ] + "/ a single name given - the module becomes 'stx' or + "/ the very first directory component (if such a module exists). + "/ If the component includes slashes, its the directory + "/ otherwise the library + "/ + dirComponents := Filename concreteClass components:(components at:1). + + (dirComponents size > 1 + and:[(mgr := self sourceCodeManager) notNil + and:[mgr checkForExistingModule:dirComponents first]]) ifTrue:[ + moduleString := dirComponents first. + directoryString := libraryString := (Filename fromComponents:(dirComponents copyFrom:2)) asString. + ] ifFalse:[ + moduleString := 'stx'. + directoryString := libraryString := components at:1. + ]. + + (libraryString includes:$/) ifTrue:[ + libraryString := libraryString asFilename baseName + ] ] ifFalse:[ - components size == 2 ifTrue:[ - "/ two components - assume its the module and the directory; - "/ the library is assumed to be named after the directory - "/ except, if slashes are in the name; then the libraryname - "/ is the last component. - "/ - moduleString := components at:1. - directoryString := libraryString := components at:2. - (libraryString includes:$/) ifTrue:[ - libraryString := libraryString asFilename baseName - ] - ] ifFalse:[ - "/ all components given - moduleString := components at:1. - directoryString := components at:2. - libraryString := components at:3. - ] + components size == 2 ifTrue:[ + "/ two components - assume its the module and the directory; + "/ the library is assumed to be named after the directory + "/ except, if slashes are in the name; then the libraryname + "/ is the last component. + "/ + moduleString := components at:1. + directoryString := libraryString := components at:2. + (libraryString includes:$/) ifTrue:[ + libraryString := libraryString asFilename baseName + ] + ] ifFalse:[ + "/ all components given + moduleString := components at:1. + directoryString := components at:2. + libraryString := components at:3. + ] ]. libraryString isEmpty ifTrue:[ - directoryString notEmpty ifTrue:[ - libraryString := directoryString asFilename baseName - ]. - libraryString isEmpty ifTrue:[ - "/ lets extract the library from the liblist file ... - libraryString := Smalltalk libraryFileNameOfClass:self. - libraryString isNil ifTrue:[^ nil]. - ] + directoryString notEmpty ifTrue:[ + libraryString := directoryString asFilename baseName + ]. + libraryString isEmpty ifTrue:[ + "/ lets extract the library from the liblist file ... + libraryString := Smalltalk libraryFileNameOfClass:self. + libraryString isNil ifTrue:[^ nil]. + ] ]. moduleString isEmpty ifTrue:[ - moduleString := 'stx'. + moduleString := 'stx'. ]. directoryString isEmpty ifTrue:[ - directoryString := libraryString. + directoryString := libraryString. ]. ^ IdentityDictionary - with:(#module->moduleString) - with:(#directory->directoryString) - with:(#library->libraryString) + with:(#module->moduleString) + with:(#directory->directoryString) + with:(#library->libraryString) " Object packageSourceCodeInfo @@ -3397,7 +3411,7 @@ info := self revisionInfo. info notNil ifTrue:[ - ^ info at:#revision ifAbsent:nil + ^ info at:#revision ifAbsent:nil ]. ^ self binaryRevision @@ -3418,7 +3432,7 @@ info := self revisionInfo. info notNil ifTrue:[ - ^ info at:#date ifAbsent:'??/??/??' + ^ info at:#date ifAbsent:'??/??/??' ]. ^ '??/??/??' @@ -3433,29 +3447,29 @@ "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 - #revision - the revision upon which the class is based logically - (different, if a changed class was checked in, but not yet recompiled) - #user - the user who checked in the logical revision - #date - the date when the logical revision was checked in - #time - the time when the logical revision was checked in - #fileName - the classes source file name - #repositoryPath - the classes source container + #binaryRevision - the revision upon which the binary of this class is based + #revision - the revision upon which the class is based logically + (different, if a changed class was checked in, but not yet recompiled) + #user - the user who checked in the logical revision + #date - the date when the logical revision was checked in + #time - the time when the logical revision was checked in + #fileName - the classes source file name + #repositoryPath - the classes source container " |vsnString info mgr| vsnString := self revisionString. vsnString notNil ifTrue:[ - mgr := self sourceCodeManager. - mgr notNil ifTrue:[ - info := mgr revisionInfoFromString:vsnString - ] ifFalse:[ - info := Class revisionInfoFromString:vsnString. - ]. - info notNil ifTrue:[ - info at:#binaryRevision put:self binaryRevision. - ] + mgr := self sourceCodeManager. + mgr notNil ifTrue:[ + info := mgr revisionInfoFromString:vsnString + ] ifFalse:[ + info := Class revisionInfoFromString:vsnString. + ]. + info notNil ifTrue:[ + info at:#binaryRevision put:self binaryRevision. + ] ]. ^ info @@ -3486,24 +3500,24 @@ 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 isNil ifTrue:[^ nil]. + m := cls compiledMethodAt:#version. + m isNil ifTrue:[^ nil]. ]. m isExecutable ifTrue:[ - "/ - "/ if its a method returning the string, - "/ thats the returned value - "/ - val := cls version. - val isString ifTrue:[^ val]. + "/ + "/ if its a method returning the string, + "/ thats the returned value + "/ + val := cls version. + val isString ifTrue:[^ val]. ]. "/ @@ -3519,7 +3533,7 @@ " Smalltalk allClassesDo:[:cls | - Transcript showCR:cls revisionString + Transcript showCR:cls revisionString ]. Number revisionString @@ -3557,42 +3571,42 @@ 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, - dir := info at:#directory ifAbsent:nil. "/ libbasic, libtool ... - lib := info at:#library ifAbsent:dir. - - p := ''. - mod notNil ifTrue:[ - mod ~= 'stx' ifTrue:[ - p := p , mod - ] - ]. - dir notNil ifTrue:[ - p notEmpty ifTrue:[p := p , ':']. - p := p , dir. - ]. - lib notNil ifTrue:[ - lib ~= dir ifTrue:[ - p notEmpty ifTrue:[p := p , ':']. - p := p , lib. - ] - ]. - (p notEmpty and:[p ~= package]) ifTrue:[ + mod := info at:#module ifAbsent:nil. "/ stx, aeg, + dir := info at:#directory ifAbsent:nil. "/ libbasic, libtool ... + lib := info at:#library ifAbsent:dir. + + p := ''. + mod notNil ifTrue:[ + mod ~= 'stx' ifTrue:[ + p := p , mod + ] + ]. + dir notNil ifTrue:[ + p notEmpty ifTrue:[p := p , ':']. + p := p , dir. + ]. + lib notNil ifTrue:[ + lib ~= dir ifTrue:[ + p notEmpty ifTrue:[p := p , ':']. + p := p , lib. + ] + ]. + (p notEmpty and:[p ~= package]) ifTrue:[ "/ package notNil ifTrue:[ "/ (name , ': changing packageID from ''' , package , ''' to ''' , p , '''') infoPrintCR. "/ ]. - package := p. - - self methodDictionary do:[:aMethod | - aMethod package isNil ifTrue:[ - aMethod package:p - ] - ] - ]. + package := p. + + self methodDictionary do:[:aMethod | + aMethod package isNil ifTrue:[ + aMethod package:p + ] + ] + ]. ]. ^ self @@ -3613,9 +3627,9 @@ (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 @@ -3642,76 +3656,76 @@ ]. aStream isNil ifTrue:[ - "/ - "/ hard case - there is no source file for this class - "/ (in the source-dir-path). - "/ - - "/ - "/ look if my binary is from a dynamically loaded module, - "/ and, if so, look in the modules directory for the - "/ source file. - "/ - ObjectFileLoader notNil ifTrue:[ - ObjectFileLoader loadedObjectHandlesDo:[:h | - |f classes| - - aStream isNil ifTrue:[ - (classes := h classes) notNil ifTrue:[ - (classes includes:self) ifTrue:[ - f := h pathName. - f := f asFilename directory. - f := f construct:source. - f exists ifTrue:[ - aStream := f readStream. - ]. - ]. - ]. - ] - ]. - ]. + "/ + "/ hard case - there is no source file for this class + "/ (in the source-dir-path). + "/ + + "/ + "/ look if my binary is from a dynamically loaded module, + "/ and, if so, look in the modules directory for the + "/ source file. + "/ + ObjectFileLoader notNil ifTrue:[ + ObjectFileLoader loadedObjectHandlesDo:[:h | + |f classes| + + aStream isNil ifTrue:[ + (classes := h classes) notNil ifTrue:[ + (classes includes:self) ifTrue:[ + f := h pathName. + f := f asFilename directory. + f := f construct:source. + f exists ifTrue:[ + aStream := f readStream. + ]. + ]. + ]. + ] + ]. + ]. ]. aStream isNil ifTrue:[ - "/ mhmh - still no source file. - "/ If there is a SourceCodeManager, ask it to aquire the - "/ the source for my class, and return an open stream on it. - "/ if that one does not know about the source, look in - "/ standard places - - mgr notNil ifTrue:[ - aStream := mgr getSourceStreamFor:self. - aStream notNil ifTrue:[ - (self validateSourceStream:aStream) ifFalse:[ - ('Class [info]: repositories source for `' - , (self isMeta ifTrue:[self soleInstance name] - ifFalse:[name]) - , ''' is invalid.') infoPrintCR. - aStream close. - aStream := nil - ] ifTrue:[ - validated := true. - ]. - ]. - - aStream isNil ifTrue:[ + "/ mhmh - still no source file. + "/ If there is a SourceCodeManager, ask it to aquire the + "/ the source for my class, and return an open stream on it. + "/ if that one does not know about the source, look in + "/ standard places + + mgr notNil ifTrue:[ + aStream := mgr getSourceStreamFor:self. + aStream notNil ifTrue:[ + (self validateSourceStream:aStream) ifFalse:[ + ('Class [info]: repositories source for `' + , (self isMeta ifTrue:[self soleInstance name] + ifFalse:[name]) + , ''' is invalid.') infoPrintCR. + aStream close. + aStream := nil + ] ifTrue:[ + validated := true. + ]. + ]. + + aStream isNil ifTrue:[ aStream := self localSourceStreamFor:source. - ]. - ]. - - "/ - "/ final chance: try current directory - "/ - aStream isNil ifTrue:[ - aStream := source asFilename readStream. - ]. + ]. + ]. + + "/ + "/ final chance: try current directory + "/ + aStream isNil ifTrue:[ + aStream := source asFilename readStream. + ]. ]. (aStream notNil and:[validated not]) ifTrue:[ - (self validateSourceStream:aStream) ifFalse:[ - ('Class [warning]: source for ''' , self name , ''' is invalid. Take care.') errorPrintCR - ]. + (self validateSourceStream:aStream) ifFalse:[ + ('Class [warning]: source for ''' , self name , ''' is invalid. Take care.') errorPrintCR + ]. ]. ^ aStream @@ -3735,7 +3749,7 @@ cls := self. self isMeta ifFalse:[ - cls := self class + cls := self class ]. "/ m := cls compiledMethodAt:#version. @@ -3748,19 +3762,19 @@ "/ newString isNil ifTrue:[^ false]. MethodRedefinitionSignal handle:[:ex | - ex proceedWith:#keep + ex proceedWith:#keep ] do:[ - Class withoutUpdatingChangesDo:[ - Compiler compile:'version + Class withoutUpdatingChangesDo:[ + Compiler compile:'version ^ ''' , newRevisionString , ''' ' - forClass:cls - inCategory:#documentation - notifying:nil - install:true - skipIfSame:false - silent:true. - ] + forClass:cls + inCategory:#documentation + notifying:nil + install:true + skipIfSame:false + silent:true. + ] ]. "/ ('updated to :' , newRevisionString) printNL. @@ -3779,9 +3793,9 @@ 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. @@ -3789,20 +3803,20 @@ versionMethod := meta compiledMethodAt:#version. (versionMethod isNil or:[versionMethod isExecutable not]) ifTrue:[ - versionMethod := cls compiledMethodAt:#version. - (versionMethod isNil - or:[versionMethod isExecutable not]) ifTrue:[ - cannotCheckReason := 'no valid version method'. - ] + versionMethod := cls compiledMethodAt:#version. + (versionMethod isNil + or:[versionMethod isExecutable not]) ifTrue:[ + cannotCheckReason := 'no valid version method'. + ] ] ifFalse:[ - "/ - "/ if its a method returning the string, - "/ thats the returned value - "/ - versionFromCode := cls version. - versionFromCode isString ifFalse:[ - cannotCheckReason := 'version method does not return a string' - ]. + "/ + "/ if its a method returning the string, + "/ thats the returned value + "/ + versionFromCode := cls version. + versionFromCode isString ifFalse:[ + cannotCheckReason := 'version method does not return a string' + ]. ]. "/ @@ -3813,21 +3827,21 @@ "/ for the source ... "/ versionMethod notNil ifTrue:[ - pos := versionMethod sourcePosition. - pos isInteger ifFalse:[ - "/ mhmh - either no version method, - "/ or updated due to a checkin. - "/ in any case, this should be a good source. - - ^ true. - "/ cannotCheckReason := 'no source position for version-method' - ] + pos := versionMethod sourcePosition. + pos isInteger ifFalse:[ + "/ mhmh - either no version method, + "/ or updated due to a checkin. + "/ in any case, this should be a good source. + + ^ true. + "/ cannotCheckReason := 'no source position for version-method' + ] ]. cannotCheckReason notNil ifTrue:[ - ('Class [warning]: ' , cannotCheckReason) errorPrintCR. - 'Class [info]: cannot validate source; trusting source' infoPrintCR. - ^ true + ('Class [warning]: ' , cannotCheckReason) errorPrintCR. + 'Class [info]: cannot validate source; trusting source' infoPrintCR. + ^ true ]. oldPos := aStream position. @@ -3837,7 +3851,7 @@ (src isNil or:[src isEmpty]) ifTrue:[ "/ 'empty source for version-method' printCR. - ^ false + ^ false ]. versionFromSource := Class revisionStringFromSource:src. @@ -3849,8 +3863,8 @@ info := Class revisionInfoFromString:versionFromSource. info notNil ifTrue:[ - rev := info at:#revision. - rev = self binaryRevision ifTrue:[^ true]. + rev := info at:#revision. + rev = self binaryRevision ifTrue:[^ true]. ]. ^ false @@ -3873,5 +3887,5 @@ !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 $' ! !