--- a/Class.st Fri Oct 28 02:19:53 1994 +0100
+++ b/Class.st Fri Oct 28 02:20:19 1994 +0100
@@ -11,7 +11,7 @@
"
ClassDescription subclass:#Class
- instanceVariableNames:'classvars comment subclasses classFileName package'
+ instanceVariableNames:'classvars comment subclasses classFilename package history'
classVariableNames:'UpdatingChanges FileOutErrorSignal'
poolDictionaries:''
category:'Kernel-Classes'
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Class.st,v 1.20 1994-10-10 00:22:30 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Class.st,v 1.21 1994-10-28 01:20:19 claus Exp $
'!
!Class class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Class.st,v 1.20 1994-10-10 00:22:30 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Class.st,v 1.21 1994-10-28 01:20:19 claus Exp $
"
!
@@ -54,19 +54,27 @@
Also change management and recompilation is defined here (since the superclasses
do not have enough symbolic information to support compilation).
- For a minimum system, the compiler is planned to generate classes as subclasses of
- Behavior - to excludes all name, source info etc.,
+ For production code, the stc compiler is planned to (optionally) generate classes
+ as subclasses of Behavior - to excludes all name, source info etc.,
however, normally all classes are subclasses of Class.
Instance variables:
classvars <String> the names of the class variables
- comment <String> the classes comment
+
+ comment <String> the classes comment; either a string,
+ a number specifying the offset in classFilename, or nil
+
subclasses <Collection> cached collection of subclasses
(currently unused - but will be soon)
- classFileName <String> the file (or nil) where the classes
- sources are found (currently not used)
+
+ classFilename <String> the file (or nil) where the classes
+ sources are found
+
package <Symbol> the package, in which the class was defined
+ (not currently used)
+
+ history <any> a place for a history string (not currently used)
Class variables:
@@ -74,6 +82,8 @@
(except during startup and when filing in, this flag
is usually true)
+ FileOutErrorSignal raised when an error occurs during fileOut
+
WARNING: layout known by compiler and runtime system
"
! !
@@ -99,6 +109,10 @@
!Class class methodsFor:'signal access'!
fileOutErrorSignal
+ "return the signal raised when an error occurs while fileing out.
+ This is signalled to allow browsers some user feed back in case
+ a fileout fails (for example due to disk-full errors)"
+
^ FileOutErrorSignal
! !
@@ -110,8 +124,7 @@
|newClass|
newClass := super new.
- newClass setComment:(self comment)
- category:(self category).
+"/ newClass setComment:(self comment) category:(self category).
^ newClass
! !
@@ -451,6 +464,22 @@
comment
"return the comment (aString) of the class"
+ |stream string|
+
+ "the comment is either a string, or an integer specifying the
+ position within the classes sourcefile ...
+ "
+ comment isNumber ifTrue:[
+ classFilename notNil ifTrue:[
+ stream := Smalltalk systemFileStreamFor:('source/' , classFilename).
+ stream notNil ifTrue:[
+ stream position:comment.
+ string := String readFrom:stream.
+ stream close.
+ ^ string
+ ]
+ ]
+ ].
^ comment
"
@@ -472,18 +501,18 @@
|oldComment|
comment ~= aString ifTrue:[
- oldComment := comment.
+ oldComment := self comment.
comment := aString.
self changed:#comment with:oldComment.
self addChangeRecordForClassComment:self.
]
!
-classFileName
+classFilename
"return the name of the file from which the class was compiled.
This is currently NOT used."
- ^ classFileName
+ ^ classFilename
!
definition
@@ -645,6 +674,12 @@
^ prev
!
+updatingChanges
+ "return true if changes are recorded"
+
+ ^ UpdatingChanges
+!
+
changesStream
"return a Stream for the changes file - or nil if no update is wanted"
@@ -686,7 +721,10 @@
writingChangeDo:aBlock
"common helper to write a change record.
Opens the changefile and executes aBlock passing the stream
- as argument. WriteErrors are cought and will lead to a warning."
+ as argument. WriteErrors are cought and will lead to a warning.
+ The changefile is not kept open, to force the change to go to disk
+ as soon as possible - thus, in case of a crash, no changes should
+ be lost due to buffering."
|aStream|
@@ -997,7 +1035,11 @@
"Return a Collection of all method-category strings known in class
and all superclasses"
- ^ self addAllCategoriesTo:(OrderedCollection new)
+ |coll|
+
+ coll := OrderedCollection new.
+ self addAllCategoriesTo:coll.
+ ^ coll
! !
!Class methodsFor:'private'!
@@ -1018,17 +1060,14 @@
addCategoriesTo:aCollection
"helper - add categories to the argument, aCollection"
- |cat|
+ methodArray do:[:aMethod |
+ |cat|
- methodArray do:[:aMethod |
cat := aMethod category.
- (aCollection detect:[:element | cat = element]
- ifNone:[nil])
- isNil ifTrue:[
- aCollection add:cat
+ (aCollection includes:cat) ifFalse:[
+ aCollection add:cat
]
- ].
- ^ aCollection
+ ]
!
addAllCategoriesTo:aCollection
@@ -1038,7 +1077,7 @@
(superclass notNil) ifTrue:[
superclass addAllCategoriesTo:aCollection
].
- ^ self addCategoriesTo:aCollection
+ self addCategoriesTo:aCollection
! !
!Class methodsFor:'fileIn interface'!
@@ -1066,12 +1105,20 @@
^ (self methodsFor:aCategory) privateProtocol
!
+protectedMethodsFor:aCategory
+ "this method allows fileIn of ENVY methods
+ (although ST/X currently does NOT really enforce method visibility yet).
+ Returns a ClassCategoryReader to read in and compile methods for me."
+
+ ^ (self methodsFor:aCategory) protectedProtocol
+!
+
ignoredMethodsFor:aCategory
"this is a speciality of ST/X - it allows quick commenting of methods
from a source-file by replacing the 'methodsFor:' by 'ignoredMethodsFor'.
Returns a ClassCategoryReader to read in and skip methods."
- ^ (self methodsFor:aCategory) ignoreMethods
+ ^ ClassCategoryReader skippingChunks
!
methods
@@ -1079,6 +1126,27 @@
return a ClassCategoryReader to read in and compile methods for me."
^ ClassCategoryReader class:self category:'ST/V methods'
+!
+
+primitiveDefinitions
+ "this method allows fileIn of classes with primitive code
+ outside of methods - it returns a CCReader which skips the next chunks"
+
+ ^ ClassCategoryReader skippingChunks
+!
+
+primitiveVariables
+ "this method allows fileIn of classes with primitive code
+ outside of methods - it returns a CCReader which skips the next chunks"
+
+ ^ ClassCategoryReader skippingChunks
+!
+
+primitiveFunctions
+ "this method allows fileIn of classes with primitive code
+ outside of methods - it returns a CCReader which skips the next chunks"
+
+ ^ ClassCategoryReader skippingChunks
! !
!Class methodsFor:'c function interfacing'!
@@ -1088,11 +1156,19 @@
The function can be called by sending selector to the receiver class.
The c-function has the name cFunctionNameString, and expects parameters as specified in
argTypeArray. The functions return value has a type as specified by returnType.
- Warning: this interface is EXPERIMENTAL - it may change or even be removed."
+ WARNING:
+ this interface is EXPERIMENTAL - it may change or even be removed."
+
+ StubGenerator isNil ifTrue:[
+ ^ self error:'this system does not support dynamic C Interface functions'.
+ ].
- StubGenerator createStubFor:selector calling:cFunctionNameString
- args:argTypeArray returning:returnType
- in:self
+ StubGenerator
+ createStubFor:selector
+ calling:cFunctionNameString
+ args:argTypeArray
+ returning:returnType
+ in:self
"
Object subclass:#CInterface
@@ -1353,9 +1429,18 @@
"
collectionOfCategories := self class categories.
collectionOfCategories notNil ifTrue:[
+ "
+ documentation first
+ "
+ (collectionOfCategories includes:'documentation') ifTrue:[
+ self class fileOutCategory:'documentation' on:aStream.
+ aStream cr
+ ].
collectionOfCategories do:[:aCategory |
- self class fileOutCategory:aCategory on:aStream.
- aStream cr
+ aCategory ~= 'documentation' ifTrue:[
+ self class fileOutCategory:aCategory on:aStream.
+ aStream cr
+ ]
]
].
"