"

 COPYRIGHT (c) 1989 by Claus Gittinger

	       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

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

'From Smalltalk/X, Version:2.10.8 on 29-oct-1995 at 19:51:30'                   !

ClassDescription subclass:#Class

	 instanceVariableNames:'classvars comment subclasses classFilename package revision

		history'

	 classVariableNames:'UpdatingChanges LockChangesFile FileOutErrorSignal CatchMethodRedefinitions

		MethodRedefinitionSignal UpdateChangeFileQuerySignal'

	 poolDictionaries:''

	 category:'Kernel-Classes'

!

!Class class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 by Claus Gittinger

	       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

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

version

!

documentation

"

    Class adds more functionality to classes; minimum stuff has already

    been defined in Behavior and ClassDescription; this adds naming, categories etc.

    Also change management and recompilation is defined here (since the superclasses

    do not have enough symbolic information to support compilation).

    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; 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 

	package         <Symbol>        the package, in which the class was defined

					(inserted by compilers)

	revision        <String>        revision string - inserted by stc

	history         <any>           a place for a history string (not currently used)

    Class variables:

	UpdatingChanges <Boolean>       true if the changes-file shall be updated

					(except during startup and when filing in, this flag

					 is usually true)

	LockChangesFile <Boolean>       if true, the change file is locked for updates.

					Required when multiple users operate on a common

					change file.

					This is an experimental new feature, being evaluated.

	UpdateChangeFileQuerySignal     used as an upQuery from the change management.

					Whenever a changeRecord is to be written,

					this signal is raised and a handler (if present)

					is supposed to return true or false.

					If unhandled, the value of the global

					UpdatingChanges is returned for backward

					compatibility (which means that the old

					mechanism is used if no query-handler

					is present).

	FileOutErrorSignal              raised when an error occurs during fileOut

	CatchMethodRedefinitions        if true, classes protect themself 

	MethodRedefinitionSignal        (by raising MethodRedefinitionSignal)

					from redefining any existing methods,

					which are defined in another package.

					(i.e. a signal will be raised, if you

					 fileIn something which redefines an

					 existing method and the packages do not

					 match).

					The default is (currently) true.

    WARNING: layout known by compiler and runtime system

"

! !

!Class class methodsFor:'initialization'!

initialize

    "the classvariable 'UpdatingChanges' controls if changes are put

     into the changes-file; normally this variable is set to true, but

     (for example) during fileIn or when changes are applied, it is set to false

     to avoid putting too much junk into the changes-file."

    UpdatingChanges := true.

    LockChangesFile := false.

    CatchMethodRedefinitions := true.

    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].

    ]

! !

!Class class methodsFor:'Signal constants'!

updateChangeFileQuerySignal

    "return the signal used as an upQuery if the changeFile should be updated.

     If unhandled, the value of UpdatingChanges is returned by the signals

     static handler."

    ^ UpdateChangeFileQuerySignal

!

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

!

methodRedefinitionSignal

    "return the signal raised when a method is about to be installed

     which redefines an existing method and the methods packages are not

     equal. This helps when filing in alien code, to prevent existing

     methods to be overwritten or redefined by incompatible methods"

    ^ MethodRedefinitionSignal

! !

!Class class methodsFor:'accessing - flags'!

updateChanges:aBoolean

    "turn on/off changes management. Return the prior value of the flag."

    |prev|

    prev := UpdatingChanges.

    UpdatingChanges := aBoolean.

    ^ prev

!

lockChangesFile:aBoolean

    "turn on/off change-file-locking. Return the previous value of the flag."

    |prev|

    prev := LockChangesFile.

    LockChangesFile := aBoolean.

    ^ prev

!

catchMethodRedefinitions:aBoolean

    "turn on/off redefinition catching. Return the prior value of the flag."

    |prev|

    prev := CatchMethodRedefinitions.

    CatchMethodRedefinitions := aBoolean.

    ^ prev

!

updatingChanges

    "return true if changes are recorded"

    ^ UpdatingChanges

!

lockChangesFile

    "return true, if the change file is locked during update"

    ^ LockChangesFile

!

catchMethodRedefinitions

    "return the redefinition catching flag."

    ^ CatchMethodRedefinitions

! !

!Class class methodsFor:'enumeration '!

allClassesInCategory:aCategory do:aBlock

    "evaluate aBlock for all classes in aCategory;

     no specific order is defined."

    Smalltalk allBehaviorsDo:[:aClass |

	aClass isMeta ifFalse:[

	    (aClass category = aCategory) ifTrue:[

		aBlock value:aClass

	    ]

	].

    ]

    "

     Class allClassesInCategory:'Kernel-Classes' 

			     do:[:class |Transcript showCr:class name]

    "

!

allClassesInCategory:aCategory inOrderDo:aBlock

    "evaluate aBlock for all classes in aCategory;

     superclasses come first - then subclasses."

    |classes|

    classes := OrderedCollection new.

    Smalltalk allBehaviorsDo:[:aClass |

	aClass isMeta ifFalse:[

	    (aClass category = aCategory) ifTrue:[

		classes add:aClass

	    ]

	]

    ].

    classes topologicalSort:[:a :b | b isSubclassOf:a].

    classes do:aBlock

! !

!Class methodsFor:'ST/V subclass creation'!

subclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s

    "this method allows fileIn of ST/V classes 

     (which seem to have no category)"

    ^ self subclass:t 

	   instanceVariableNames:f

	   classVariableNames:d

	   poolDictionaries:s

	   category:'ST/V classes'

!

variableByteSubclass:t classVariableNames:d poolDictionaries:s

    "this method allows fileIn of ST/V variable byte classes 

     (which seem to have no category and no instvars)"

    ^ self variableByteSubclass:t 

	   instanceVariableNames:''

	   classVariableNames:d

	   poolDictionaries:s

	   category:'ST/V classes'

!

variableSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s

    "this method allows fileIn of ST/V variable pointer classes 

     (which seem to have no category)"

    ^ self variableSubclass:t 

	   instanceVariableNames:f

	   classVariableNames:d

	   poolDictionaries:s

	   category:'ST/V classes'

! !

!Class methodsFor:'accessing'!

allClassVarNames

    "return a collection of all the class variable name-strings

     this includes all superclass-class variables"

    ^ self addAllClassVarNamesTo:(OrderedCollection new)

    "

     Float allClassVarNames

    "

!

classVarNames

    "return a collection of the class variable name-strings.

     Only names of class variables defined in this class are included

     in the returned collection - use allClassVarNames, to get all known names."

    classvars isNil ifTrue:[

	^ OrderedCollection new

    ].

    ^ classvars asCollectionOfWords

    "

     Object classVarNames 

     Float classVarNames

    "

!

classVariableString:aString

    "set the classes classvarnames string; 

     Initialize new class variables with nil, clear and remove old ones. 

     No change record is written and no classes are recompiled."

    |prevVarNames varNames any|

    "ignore for metaclasses except the one"

    (self isMeta) ifTrue:[

	(self == Metaclass) ifFalse:[

	    ^ self

	]

    ].

    (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

	].

    ]

!

setComment:com category:categoryStringOrSymbol

    "set the comment and category of the class;

     do NOT create a change record"

    |cat|

    comment := com.

    categoryStringOrSymbol isNil ifTrue:[

	cat := ''

    ] ifFalse:[

	cat := categoryStringOrSymbol

    ].

    category := cat asSymbol

!

revision

    "return the revision-ID of the class which corresponds to the

     rcs-id of the source from which this class was compiled.

     This is always valid for stc-compiled classes which include a version method,

     since stc extracts this info and places it into an instance variable.

     this is used with filed-In classes (non stc-compiled).

     To check if a source corresponds to a compiled binary, compare this 

     ID with the one found in the version-methods comment."

    |vsnString words|

    revision notNil ifTrue:[ ^ revision].

    vsnString notNil ifTrue:[

	words := vsnString asCollectionOfWords.

	"/

	"/ supported formats:

	"/

	"/ $-Header: pathName rev date time user state $

	"/ $-Revision: rev $

	"/ $-Id: fileName rev date time user state $

	"/

	    ^ words at:3

	].

	    ^ words at:2 

	].

	    ^ words at:3 

	].

    ].

    ^ nil

    "

     Object revision 

    "

    "Created: 11.11.1995 / 14:27:20 / cg"

!

classVariableString

    "return a string of the class variables names.

     Only names of class variables defined in this class are in the

     returned string."

    classvars isNil ifTrue:[^ ''].

    ^ classvars

    "

     Object classVariableString 

     Float classVariableString  

    "

!

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 := self sourceStream. "/ Smalltalk sourceFileStreamFor:classFilename.

	    stream notNil ifTrue:[

		stream position:comment.

		string := String readFrom:stream onError:''.

		stream close.

		^ string

	    ]

	]

    ].

    ^ comment

    "

     Object comment 

    "

!

classVarAt:aSymbol

    "return the value of a class variable.

     Currently, this returns nil if there is no such classvar -

     this may change."

    "

     this hides the (current) implementation of classVariables

     from the outside world. Currently, classvars are stored in

     the Smalltalk dictionary with a funny name, since there are

     no classPools yet.

    "

    ^ Smalltalk at:(self name , ':' , aSymbol) asSymbol

!

classVarAt:aSymbol put:something

    "store something in a classvariable.

     Currently this creates a global with a funny name if no such

     classVar exists - this may change."

    "

     this hides the (current) implementation of classVariables

     from the outside world. Currently, classvars are stored in

     the Smalltalk dictionary with a funny name, since there are

     no classPools yet.

    "

    Smalltalk at:(self name , ':' , aSymbol) asSymbol put:something.

!

setComment:aString

    "set the comment of the class to be the argument, aString;

     do NOT create a change record"