diff -r 0d8dd47d386a -r 840b03d131d7 Class.st --- a/Class.st Thu Mar 21 15:30:45 1996 +0100 +++ b/Class.st Thu Mar 21 16:33:40 1996 +0100 @@ -15,7 +15,8 @@ history' classVariableNames:'UpdatingChanges LockChangesFile FileOutErrorSignal CatchMethodRedefinitions MethodRedefinitionSignal - UpdateChangeFileQuerySignal TryLocalSourceFirst' + UpdateChangeFileQuerySignal TryLocalSourceFirst + ChangeFileAccessLock' poolDictionaries:'' category:'Kernel-Classes' ! @@ -127,19 +128,23 @@ TryLocalSourceFirst := false. FileOutErrorSignal isNil ifTrue:[ - FileOutErrorSignal := ErrorSignal newSignalMayProceed:false. - FileOutErrorSignal nameClass:self message:#fileOutErrorSignal. - FileOutErrorSignal notifierString:'error during fileOut'. - - MethodRedefinitionSignal := ErrorSignal newSignalMayProceed:true. - MethodRedefinitionSignal nameClass:self message:#methodRedefinitionSignal. - MethodRedefinitionSignal notifierString:'attempt to redefine method from different package'. - - UpdateChangeFileQuerySignal := QuerySignal new mayProceed:true. - UpdateChangeFileQuerySignal nameClass:self message:#updateChangeFileQuerySignal. - UpdateChangeFileQuerySignal notifierString:'asking if changeFile update is wanted'. - UpdateChangeFileQuerySignal handlerBlock:[:ex | ex proceedWith:UpdatingChanges]. + FileOutErrorSignal := ErrorSignal newSignalMayProceed:false. + FileOutErrorSignal nameClass:self message:#fileOutErrorSignal. + FileOutErrorSignal notifierString:'error during fileOut'. + + MethodRedefinitionSignal := ErrorSignal newSignalMayProceed:true. + MethodRedefinitionSignal nameClass:self message:#methodRedefinitionSignal. + MethodRedefinitionSignal notifierString:'attempt to redefine method from different package'. + + UpdateChangeFileQuerySignal := QuerySignal new mayProceed:true. + UpdateChangeFileQuerySignal nameClass:self message:#updateChangeFileQuerySignal. + UpdateChangeFileQuerySignal notifierString:'asking if changeFile update is wanted'. + UpdateChangeFileQuerySignal handlerBlock:[:ex | ex proceedWith:UpdatingChanges]. + + ChangeFileAccessLock := Semaphore forMutualExclusion. ] + + "Modified: 21.3.1996 / 16:31:30 / cg" ! ! !Class class methodsFor:'Signal constants'! @@ -1288,43 +1293,12 @@ self writingChangePerform:#addChangeRecordForChangeCategory:to: with:category. ! -addChangeRecordForChangeCategory:category to:aStream - "append a category change record to aStream" - - self printClassNameOn:aStream. - aStream nextPutAll:(' category:' , category storeString). - aStream nextPutChunkSeparator. - - "this test allows a smalltalk without Projects/ChangeSets" - Project notNil ifTrue:[ - Project addClassDefinitionChangeFor:self - ] - - "Created: 3.12.1995 / 13:43:33 / cg" - "Modified: 3.12.1995 / 14:10:34 / cg" -! - addChangeRecordForClass:aClass "add a class-definition-record to the changes file" self writingChangePerform:#addChangeRecordForClass:to: with:aClass. ! -addChangeRecordForClass:aClass to:aStream - "append a class-definition-record to aStream" - - aClass isLoaded ifTrue:[ - aClass fileOutDefinitionOn:aStream. - aStream nextPutChunkSeparator. - Project notNil ifTrue:[ - Project addClassDefinitionChangeFor:aClass - ] - ] - - "Created: 3.12.1995 / 13:57:44 / cg" - "Modified: 3.12.1995 / 14:11:26 / cg" -! - addChangeRecordForClassCheckIn:aClass "append a class-was-checkedIn-record to the changes file" @@ -1340,14 +1314,6 @@ self writingChangePerform:#addChangeRecordForClassComment:to: with:aClass. ! -addChangeRecordForClassComment:aClass to:aStream - "append a class-comment-record to aStream" - - aClass fileOutCommentOn:aStream. - - "Modified: 4.3.1996 / 16:49:08 / cg" -! - addChangeRecordForClassFileOut:aClass "append a class-was-filedOut-record to the changes file" @@ -1360,26 +1326,12 @@ self writingChangePerform:#addChangeRecordForClassInstvars:to: with:aClass. ! -addChangeRecordForClassInstvars:aClass to:aStream - "append a class-instvars-record to aStream" - - aClass fileOutClassInstVarDefinitionOn:aStream. - aStream nextPutChunkSeparator. -! - addChangeRecordForClassRemove:oldName "add a class-remove-record to the changes file" self writingChangePerform:#addChangeRecordForClassRemove:to: with:oldName. ! -addChangeRecordForClassRemove:oldName to:aStream - "append a class-remove-record to aStream" - - aStream nextPutAll:('Smalltalk removeClass:' , oldName). - aStream nextPutChunkSeparator. -! - addChangeRecordForClassRename:oldName to:newName "add a class-rename-record to the changes file" @@ -1388,13 +1340,6 @@ ] ! -addChangeRecordForClassRename:oldName to:newName to:aStream - "append a class-rename-record to aStream" - - aStream nextPutAll:('Smalltalk renameClass:' , oldName , ' to:''' , newName , ''''). - aStream nextPutChunkSeparator. -! - addChangeRecordForMethod:aMethod "add a method-change-record to the changes file" @@ -1407,12 +1352,6 @@ ] ! -addChangeRecordForMethod:aMethod to:aStream - "append a method-change-record to aStream" - - self fileOutMethod:aMethod on:aStream. -! - addChangeRecordForMethodCategory:aMethod category:aString "add a methodCategory-change-record to the changes file" @@ -1428,21 +1367,6 @@ ] ! -addChangeRecordForMethodCategory:aMethod category:newCategory to:aStream - "append a methodCategory-change-record to aStream" - - |selector| - - selector := aMethod selector. - selector notNil ifTrue:[ - aStream nextPutAll:'('. - self printClassNameOn:aStream. - aStream nextPutAll:(' compiledMethodAt:' , selector storeString). - aStream nextPutAll:(') category:' , newCategory storeString). - aStream nextPutChunkSeparator. - ] -! - addChangeRecordForMethodPrivacy:aMethod "add a method-privacy-change-record to the changes file" @@ -1457,23 +1381,6 @@ "Modified: 27.8.1995 / 22:47:32 / claus" ! -addChangeRecordForMethodPrivacy:aMethod to:aStream - "append a method-privacy-change-record to aStream" - - |selector| - - selector := aMethod selector. - selector notNil ifTrue:[ - aStream nextPutAll:'('. - self printClassNameOn:aStream. - aStream nextPutAll:(' compiledMethodAt:' , selector storeString). - aStream nextPutAll:(') privacy:' , aMethod privacy storeString). - aStream nextPutChunkSeparator. - ] - - "Modified: 27.8.1995 / 22:59:56 / claus" -! - addChangeRecordForPrimitiveDefinitions:aClass "add a primitiveDefinitions-record to the changes file" @@ -1485,14 +1392,6 @@ ] ! -addChangeRecordForPrimitiveDefinitions:aClass to:aStream - "append a primitiveDefinitions-record to aStream" - - aStream nextPutAll:aClass name; nextPutAll:' primitiveDefinitions:'''; cr; - nextPutAll:(aClass primitiveDefinitionsString storeString copyFrom:2). - aStream nextPutChunkSeparator. -! - addChangeRecordForPrimitiveFunctions:aClass "add a primitiveFunctions-record to the changes file" @@ -1504,14 +1403,6 @@ ] ! -addChangeRecordForPrimitiveFunctions:aClass to:aStream - "append a primitiveFunctions-record to aStream" - - aStream nextPutAll:aClass name; nextPutAll:' primitiveFunctions:'''; cr; - nextPutAll:(aClass primitiveFunctionsString storeString copyFrom:2). - aStream nextPutChunkSeparator. -! - addChangeRecordForPrimitiveVariables:aClass "add a primitiveVariables-record to the changes file" @@ -1523,28 +1414,12 @@ ] ! -addChangeRecordForPrimitiveVariables:aClass to:aStream - "append a primitiveVariables-record to aStream" - - aStream nextPutAll:aClass name; nextPutAll:' primitiveVariables:'''; cr; - nextPutAll:(aClass primitiveVariablesString storeString copyFrom:2). - aStream nextPutChunkSeparator. -! - addChangeRecordForRemoveSelector:aSelector "add a method-remove-record to the changes file" self writingChangePerform:#addChangeRecordForRemoveSelector:to: with:aSelector. ! -addChangeRecordForRemoveSelector:aSelector to:aStream - "append a method-remove-record to aStream" - - self printClassNameOn:aStream. - aStream nextPutAll:(' removeSelector:#' , aSelector). - aStream nextPutChunkSeparator. -! - addChangeRecordForRenameCategory:oldCategory to:newCategory "add a category-rename record to the changes file" @@ -1553,15 +1428,6 @@ ] ! -addChangeRecordForRenameCategory:oldCategory to:newCategory to:aStream - "append a category-rename record to aStream" - - self printClassNameOn:aStream. - aStream nextPutAll:(' renameCategory:' , oldCategory storeString). - aStream nextPutAll:(' to:' , newCategory storeString). - aStream nextPutChunkSeparator. -! - addChangeRecordForSnapshot:aFileName "add a snapshot-record to the changes file" @@ -1593,16 +1459,6 @@ "Modified: 18.11.1995 / 15:45:10 / cg" ! -addInfoRecord:aMessage to:aStream - "append an info-record (snapshot, class fileOut etc.) to aStream" - - aStream nextPutAll:('''---- ' , aMessage , ' ', - Date today printString , ' ' , - Time now printString , - ' ----'''). - aStream nextPutChunkSeparator. -! - changesStream "return a Stream for the writing changes file - or nil if no update is wanted" @@ -1665,60 +1521,6 @@ ] do:[ aBlock value ]. -! - -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. - 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." - - self writingChangeWithTimeStamp:true do:aBlock - - "Modified: 18.11.1995 / 15:43:36 / cg" -! - -writingChangePerform:aSelector with:anArgument - self writingChangeWithTimeStamp:true perform:aSelector with:anArgument - - "Created: 28.10.1995 / 16:50:48 / cg" - "Modified: 18.11.1995 / 15:44:53 / cg" -! - -writingChangeWithTimeStamp:doStampIt do: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. - 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| - - aStream := self changesStream. - aStream notNil ifTrue:[ - FileStream writeErrorSignal handle:[:ex | - self warn:('could not update the changes-file\\' , ex errorString) withCRs. - ex return - ] do:[ - doStampIt ifTrue:[self addChangeTimeStampTo:aStream]. - aBlock value:aStream. - aStream cr. - ]. - aStream close - ] - - "Created: 18.11.1995 / 15:36:02 / cg" -! - -writingChangeWithTimeStamp:stampIt perform:aSelector with:anArgument - self writingChangeWithTimeStamp:stampIt do:[:stream | - self perform:aSelector with:anArgument with:stream. - ] - - "Created: 18.11.1995 / 15:44:28 / cg" ! ! !Class methodsFor:'compiling'! @@ -3005,7 +2807,215 @@ " ! ! -!Class methodsFor:'private'! +!Class methodsFor:'private changes management'! + +addChangeRecordForChangeCategory:category to:aStream + "append a category change record to aStream" + + self printClassNameOn:aStream. + aStream nextPutAll:(' category:' , category storeString). + aStream nextPutChunkSeparator. + + "this test allows a smalltalk without Projects/ChangeSets" + Project notNil ifTrue:[ + Project addClassDefinitionChangeFor:self + ] + + "Created: 3.12.1995 / 13:43:33 / cg" + "Modified: 3.12.1995 / 14:10:34 / cg" +! + +addChangeRecordForClass:aClass to:aStream + "append a class-definition-record to aStream" + + aClass isLoaded ifTrue:[ + aClass fileOutDefinitionOn:aStream. + aStream nextPutChunkSeparator. + Project notNil ifTrue:[ + Project addClassDefinitionChangeFor:aClass + ] + ] + + "Created: 3.12.1995 / 13:57:44 / cg" + "Modified: 3.12.1995 / 14:11:26 / cg" +! + +addChangeRecordForClassComment:aClass to:aStream + "append a class-comment-record to aStream" + + aClass fileOutCommentOn:aStream. + + "Modified: 4.3.1996 / 16:49:08 / cg" +! + +addChangeRecordForClassInstvars:aClass to:aStream + "append a class-instvars-record to aStream" + + aClass fileOutClassInstVarDefinitionOn:aStream. + aStream nextPutChunkSeparator. +! + +addChangeRecordForClassRemove:oldName to:aStream + "append a class-remove-record to aStream" + + aStream nextPutAll:('Smalltalk removeClass:' , oldName). + aStream nextPutChunkSeparator. +! + +addChangeRecordForClassRename:oldName to:newName to:aStream + "append a class-rename-record to aStream" + + aStream nextPutAll:('Smalltalk renameClass:' , oldName , ' to:''' , newName , ''''). + aStream nextPutChunkSeparator. +! + +addChangeRecordForMethod:aMethod to:aStream + "append a method-change-record to aStream" + + self fileOutMethod:aMethod on:aStream. +! + +addChangeRecordForMethodCategory:aMethod category:newCategory to:aStream + "append a methodCategory-change-record to aStream" + + |selector| + + selector := aMethod selector. + selector notNil ifTrue:[ + aStream nextPutAll:'('. + self printClassNameOn:aStream. + aStream nextPutAll:(' compiledMethodAt:' , selector storeString). + aStream nextPutAll:(') category:' , newCategory storeString). + aStream nextPutChunkSeparator. + ] +! + +addChangeRecordForMethodPrivacy:aMethod to:aStream + "append a method-privacy-change-record to aStream" + + |selector| + + selector := aMethod selector. + selector notNil ifTrue:[ + aStream nextPutAll:'('. + self printClassNameOn:aStream. + aStream nextPutAll:(' compiledMethodAt:' , selector storeString). + aStream nextPutAll:(') privacy:' , aMethod privacy storeString). + aStream nextPutChunkSeparator. + ] + + "Modified: 27.8.1995 / 22:59:56 / claus" +! + +addChangeRecordForPrimitiveDefinitions:aClass to:aStream + "append a primitiveDefinitions-record to aStream" + + aStream nextPutAll:aClass name; nextPutAll:' primitiveDefinitions:'''; cr; + nextPutAll:(aClass primitiveDefinitionsString storeString copyFrom:2). + aStream nextPutChunkSeparator. +! + +addChangeRecordForPrimitiveFunctions:aClass to:aStream + "append a primitiveFunctions-record to aStream" + + aStream nextPutAll:aClass name; nextPutAll:' primitiveFunctions:'''; cr; + nextPutAll:(aClass primitiveFunctionsString storeString copyFrom:2). + aStream nextPutChunkSeparator. +! + +addChangeRecordForPrimitiveVariables:aClass to:aStream + "append a primitiveVariables-record to aStream" + + aStream nextPutAll:aClass name; nextPutAll:' primitiveVariables:'''; cr; + nextPutAll:(aClass primitiveVariablesString storeString copyFrom:2). + aStream nextPutChunkSeparator. +! + +addChangeRecordForRemoveSelector:aSelector to:aStream + "append a method-remove-record to aStream" + + self printClassNameOn:aStream. + aStream nextPutAll:(' removeSelector:#' , aSelector). + aStream nextPutChunkSeparator. +! + +addChangeRecordForRenameCategory:oldCategory to:newCategory to:aStream + "append a category-rename record to aStream" + + self printClassNameOn:aStream. + aStream nextPutAll:(' renameCategory:' , oldCategory storeString). + aStream nextPutAll:(' to:' , newCategory storeString). + aStream nextPutChunkSeparator. +! + +addInfoRecord:aMessage to:aStream + "append an info-record (snapshot, class fileOut etc.) to aStream" + + aStream nextPutAll:('''---- ' , aMessage , ' ', + Date today printString , ' ' , + Time now printString , + ' ----'''). + aStream nextPutChunkSeparator. +! + +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. + 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." + + self writingChangeWithTimeStamp:true do:aBlock + + "Modified: 18.11.1995 / 15:43:36 / cg" +! + +writingChangePerform:aSelector with:anArgument + self writingChangeWithTimeStamp:true perform:aSelector with:anArgument + + "Created: 28.10.1995 / 16:50:48 / cg" + "Modified: 18.11.1995 / 15:44:53 / cg" +! + +writingChangeWithTimeStamp:doStampIt do: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. + 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." + + ChangeFileAccessLock critical:[ + |aStream| + + aStream := self changesStream. + aStream notNil ifTrue:[ + FileStream writeErrorSignal handle:[:ex | + self warn:('could not update the changes-file\\' , ex errorString) withCRs. + ex return + ] do:[ + doStampIt ifTrue:[self addChangeTimeStampTo:aStream]. + aBlock value:aStream. + aStream cr. + ]. + aStream close + ] + ] + + "Created: 18.11.1995 / 15:36:02 / cg" + "Modified: 21.3.1996 / 16:32:30 / cg" +! + +writingChangeWithTimeStamp:stampIt perform:aSelector with:anArgument + self writingChangeWithTimeStamp:stampIt do:[:stream | + self perform:aSelector with:anArgument with:stream. + ] + + "Created: 18.11.1995 / 15:44:28 / cg" +! ! + +!Class methodsFor:'private helpers'! addAllCategoriesTo:aCollection "helper - add categories and all superclasses categories @@ -3087,8 +3097,9 @@ !Class methodsFor:'queries'! allCategories - "Return a Collection of all method-category strings known in class - and all superclasses. The returned collection is not sorted by any order." + "Return a collection of all method-categories known in class + and all superclasses. This does NOT include the metaclass categories. + The returned collection is not sorted by any order." |coll| @@ -3099,25 +3110,34 @@ " Point categories Point allCategories + + Point class categories + Point class allCategories " + + "Modified: 21.3.1996 / 16:28:57 / cg" ! categories - "Return a Collection of all method-category strings known in class. + "Return a collection of all method-categories known in the receiver class. + This does NOT include the metaclasses categories. The returned collection is not sorted by any order." |newList cat| newList := OrderedCollection new. methodArray do:[:aMethod | - cat := aMethod category. - newList indexOf:cat ifAbsent:[newList add:cat] + cat := aMethod category. + newList indexOf:cat ifAbsent:[newList add:cat] ]. ^ newList " - Point categories + Point categories + Point class categories " + + "Modified: 21.3.1996 / 16:28:06 / cg" ! isClass @@ -3142,9 +3162,11 @@ "return true, if this class came into the system via an autoload; false otherwise. This is not an attribute of the class, but instead remembered in - Autoload. The interface here is for covenience." + Autoload. The interface here is for your convenience." ^ Autoload wasAutoloaded:self + + "Modified: 21.3.1996 / 16:27:09 / cg" ! whichClassDefinesClassVar:aVariableName @@ -3919,6 +3941,6 @@ !Class class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.146 1996-03-19 18:46:42 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.147 1996-03-21 15:33:40 cg Exp $' ! ! Class initialize!