# HG changeset patch # User claus # Date 783307219 -3600 # Node ID 3c7266ecf04c514577c6806f14fb418ac54c7e34 # Parent f93304c133e3f3fbf9b32a2e8b68a96f82a79192 new comments, support private & protected code diff -r f93304c133e3 -r 3c7266ecf04c Class.st --- 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 the names of the class variables - comment the classes comment + + 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 (currently not used) + + classFilename the file (or nil) where the classes + sources are found + package the package, in which the class was defined + (not currently used) + + history 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 + ] ] ]. "