--- a/Class.st Tue Feb 06 15:54:13 2001 +0100
+++ b/Class.st Wed Feb 07 18:23:29 2001 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -13,11 +13,11 @@
"{ Package: 'stx:libbasic' }"
ClassDescription subclass:#Class
- instanceVariableNames:'name category classvars comment subclasses classFilename package
- revision primitiveSpec environment signature hook'
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Classes'
+ instanceVariableNames:'name category classvars comment subclasses classFilename package
+ revision primitiveSpec environment signature hook'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Classes'
!
!Class class methodsFor:'documentation'!
@@ -25,7 +25,7 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -144,10 +144,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
+ ]
].
"/
@@ -158,47 +158,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
@@ -216,17 +216,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
@@ -260,7 +260,6 @@
"Modified: 23.4.1996 / 15:56:58 / cg"
! !
-
!Class methodsFor:'Compatibility - ST80'!
fileOutSourceOn:aStream
@@ -582,16 +581,16 @@
position within the classes sourcefile ...
"
comment isNumber ifTrue:[
- classFilename notNil ifTrue:[
- stream := self sourceStream.
- stream notNil ifTrue:[
- stream position:comment.
- string := String readFrom:stream onError:''.
- stream close.
- ^ string
- ].
- ^ nil
- ]
+ classFilename notNil ifTrue:[
+ stream := self sourceStream.
+ stream notNil ifTrue:[
+ stream position:comment.
+ string := String readFrom:stream onError:''.
+ stream close.
+ ^ string
+ ].
+ ^ nil
+ ]
].
^ comment
@@ -652,10 +651,10 @@
idx := name lastIndexOf:$:.
idx ~~ 0 ifTrue:[
- (name at:idx-1) == $: ifTrue:[
- nsName := name copyTo:(idx - 2).
- environment := Smalltalk at:nsName asSymbol.
- ]
+ (name at:idx-1) == $: ifTrue:[
+ nsName := name copyTo:(idx - 2).
+ environment := Smalltalk at:nsName asSymbol.
+ ]
].
^ environment
@@ -834,8 +833,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.
@@ -1004,9 +1003,9 @@
comment := com.
categoryStringOrSymbol isNil ifTrue:[
- cat := ''
+ cat := ''
] ifFalse:[
- cat := categoryStringOrSymbol
+ cat := categoryStringOrSymbol
].
category := cat asSymbol
!
@@ -1059,19 +1058,19 @@
"
aStream := FileStream newFileNamed:'__temp'.
aStream isNil ifTrue:[
- self notify:'cannot create temporary file.'.
- ^ nil
+ self notify:'cannot create temporary file.'.
+ ^ nil
].
FileOutErrorSignal handle:[:ex |
- aStream nextPutAll:'"no source available"'.
+ aStream nextPutAll:'"no source available"'.
] do:[
- self fileOutOn:aStream.
+ self fileOutOn:aStream.
].
aStream close.
aStream := FileStream oldFileNamed:'__temp'.
aStream isNil ifTrue:[
- self notify:'oops - cannot reopen temp file'.
- ^ nil
+ self notify:'oops - cannot reopen temp file'.
+ ^ nil
].
code := aStream contents.
aStream close.
@@ -1178,9 +1177,9 @@
addGlobalsForBinaryStorageTo:globalDictionary
"
classPool == nil ifFalse: [
- classPool associationsDo: [:assoc|
- globalDictionary at: assoc put: self
- ]
+ classPool associationsDo: [:assoc|
+ globalDictionary at: assoc put: self
+ ]
]
"
@@ -1529,18 +1528,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)]
].
"
@@ -2029,10 +2028,10 @@
|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])
].
aStream nextPutAll:(self firstDefinitionSelectorPart).
@@ -2058,9 +2057,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
].
fileName := (dirName asFilename construct:nm).
fileName makeLegalFilename.
@@ -2355,9 +2354,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.
@@ -2385,16 +2384,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"
@@ -2611,22 +2610,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"
@@ -2645,13 +2644,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"
@@ -2682,9 +2681,9 @@
"append a binary representation of myself to aStream 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."
@@ -3133,7 +3132,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|
@@ -3152,9 +3151,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.
@@ -3167,12 +3166,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"
@@ -3220,7 +3219,7 @@
"this test allows a smalltalk without Projects/ChangeSets"
Project notNil ifTrue:[
- Project addClassDefinitionChangeFor:self
+ Project addClassDefinitionChangeFor:self
]
"Created: 3.12.1995 / 13:43:33 / cg"
@@ -3233,11 +3232,11 @@
"append a class-definition-record to aStream"
aClass isLoaded ifTrue:[
- aClass fileOutDefinitionOn:aStream.
- aStream nextPutChunkSeparator.
- Project notNil ifTrue:[
- Project addClassDefinitionChangeFor:aClass
- ]
+ aClass fileOutDefinitionOn:aStream.
+ aStream nextPutChunkSeparator.
+ Project notNil ifTrue:[
+ Project addClassDefinitionChangeFor:aClass
+ ]
]
"Created: 3.12.1995 / 13:57:44 / cg"
@@ -3296,7 +3295,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"
@@ -3308,7 +3307,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"
@@ -3320,7 +3319,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"
@@ -3345,16 +3344,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
@@ -3367,7 +3366,7 @@
"set a primitiveSpecification component to aString"
primitiveSpec isNil ifTrue:[
- primitiveSpec := Array new:3
+ primitiveSpec := Array new:3
].
primitiveSpec at:index put:aString
! !
@@ -3495,8 +3494,8 @@
cls := self.
[cls notNil] whileTrue:[
- (cls classVarNames includes:aVariableName) ifTrue:[ ^ cls].
- cls := cls superclass
+ (cls classVarNames includes:aVariableName) ifTrue:[ ^ cls].
+ cls := cls superclass
].
^ nil
@@ -3703,12 +3702,12 @@
nameKey := 0.
self allInstVarNames do:[:name |
- nameKey := nameKey bitShift:1.
- (nameKey bitAnd:16r10000) ~~ 0 ifTrue:[
- nameKey := nameKey bitXor:1.
- nameKey := nameKey bitAnd:16rFFFF.
- ].
- nameKey := (nameKey + (name at:1) asciiValue) bitAnd:16rFFFF.
+ nameKey := nameKey bitShift:1.
+ (nameKey bitAnd:16r10000) ~~ 0 ifTrue:[
+ nameKey := nameKey bitXor:1.
+ nameKey := nameKey bitAnd:16rFFFF.
+ ].
+ nameKey := (nameKey + (name at:1) asciiValue) bitAnd:16rFFFF.
].
value := value + (nameKey bitShift:14).
signature := value.
@@ -3735,15 +3734,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
@@ -3759,7 +3758,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'
"
@@ -4073,7 +4072,7 @@
info := self revisionInfo.
info notNil ifTrue:[
- ^ info at:#revision ifAbsent:nil
+ ^ info at:#revision ifAbsent:nil
].
^ self binaryRevision
@@ -4094,7 +4093,7 @@
info := self revisionInfo.
info notNil ifTrue:[
- ^ info at:#date ifAbsent:'??/??/??'
+ ^ info at:#date ifAbsent:'??/??/??'
].
^ '??/??/??'
@@ -4109,29 +4108,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
@@ -4162,24 +4161,25 @@
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].
+ "/ no - do NEVER care for a version method on the instance side
+ "/ 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].
].
"/
@@ -4195,7 +4195,7 @@
"
Smalltalk allClassesDo:[:cls |
- Transcript showCR:cls revisionString
+ Transcript showCR:cls revisionString
].
Number revisionString
@@ -4203,9 +4203,10 @@
Metaclass revisionString
"
- "Created: 29.10.1995 / 19:28:03 / cg"
- "Modified: 23.10.1996 / 18:23:56 / cg"
- "Modified: 1.4.1997 / 23:37:25 / stefan"
+ "Created: / 29.10.1995 / 19:28:03 / cg"
+ "Modified: / 23.10.1996 / 18:23:56 / cg"
+ "Modified: / 1.4.1997 / 23:37:25 / stefan"
+ "Modified: / 7.2.2001 / 18:03:39 / ps"
!
setBinaryRevision:aString
@@ -4288,9 +4289,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
@@ -4585,5 +4586,5 @@
!Class class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.393 2001-02-06 14:54:13 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.394 2001-02-07 17:23:29 ps Exp $'
! !