"

 COPYRIGHT (c) 1993 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.

"

Behavior subclass:#ClassDescription

	instanceVariableNames:'instvars'

	classVariableNames:'UpdatingChanges LockChangesFile FileOutErrorSignal

		CatchMethodRedefinitions MethodRedefinitionSignal

		CatchClassRedefinitions ClassRedefinitionSignal

		UpdateChangeFileQuerySignal TryLocalSourceFirst

		ChangeFileAccessLock NameSpaceQuerySignal PackageQuerySignal

		UsedNameSpaceQuerySignal CreateNameSpaceQuerySignal

		FileOutNameSpaceQuerySignal

		ChangeDefaultApplicationNotificationSignal

		DefaultApplicationQuerySignal'

	poolDictionaries:''

	category:'Kernel-Classes'

!

!ClassDescription class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1993 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.

"

!

documentation

"

    ClassDescription conceptually adds some descriptive information to the basic

    Behavior class. It is an abstract class used as a common superclass

    for Metaclass and Class.

    Subclasses must define the #name, #category and #comment methods.

    [Instance variables:]

	instvars        <String>            the names of the instance variables

    [Class variables:]

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

					(except during startup and when filing in, this flag

					 is usually true)

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

	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.

	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.

	TryLocalSourceFirst             If true, local source files are tried

					first BEFORE the sourceCodeManager is

					consulted. If false, the sourceCodeManager

					is asked first.

					Should be turned on, if you run an image from

					local sources which have not yet been checked in.

	NameSpaceQuerySignal            used as an upQuery to ask for a namespace into

					which new classes are to be installed.

	PackageQuerySignal              used as an upQuery to ask for a packageSymbol with

					which new classes/methods are to be marked.

	CreateNameSpaceQuerySignal      used as an upQuery to ask if unknown namespaces

					should be silently created (without asking the user)

    [author:]

	Claus Gittinger

    [see also:]

	Behavior Class Metaclass

"

! !

!ClassDescription 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 := CatchClassRedefinitions := true.

    TryLocalSourceFirst := false.

    FileOutErrorSignal isNil ifTrue:[

	FileOutErrorSignal := ErrorSignal newSignalMayProceed:false.

	FileOutErrorSignal nameClass:self message:#fileOutErrorSignal.

	FileOutErrorSignal notifierString:'error during fileOut'.

	MethodRedefinitionSignal := QuerySignal new.

	MethodRedefinitionSignal nameClass:self message:#methodRedefinitionSignal.

	MethodRedefinitionSignal notifierString:'attempt to redefine method from different package'.

	MethodRedefinitionSignal defaultAnswer:#keep.

	ClassRedefinitionSignal := QuerySignal new.

	ClassRedefinitionSignal nameClass:self message:#classRedefinitionSignal.

	ClassRedefinitionSignal notifierString:'attempt to redefine class from different package'.

	ClassRedefinitionSignal defaultAnswer:#keep.

	UpdateChangeFileQuerySignal := QuerySignal new.

	UpdateChangeFileQuerySignal nameClass:self message:#updateChangeFileQuerySignal.

	UpdateChangeFileQuerySignal notifierString:'asking if changeFile update is wanted'.

	UpdateChangeFileQuerySignal handlerBlock:[:ex | ex proceedWith:UpdatingChanges].

	NameSpaceQuerySignal := QuerySignal new.

	NameSpaceQuerySignal nameClass:self message:#nameSpaceQuerySignal.

	NameSpaceQuerySignal notifierString:'asking for nameSpace'.

	NameSpaceQuerySignal handlerBlock:[:ex | ex proceedWith:Smalltalk defaultNameSpace].

	UsedNameSpaceQuerySignal := QuerySignal new.

	UsedNameSpaceQuerySignal nameClass:self message:#usedNameSpaceQuerySignal.

	UsedNameSpaceQuerySignal notifierString:'asking for used nameSpaced'.

	CreateNameSpaceQuerySignal := QuerySignal new.

	CreateNameSpaceQuerySignal nameClass:self message:#createNameSpaceQuerySignal.

	CreateNameSpaceQuerySignal notifierString:'asking for nameSpace creation'.

	CreateNameSpaceQuerySignal defaultAnswer:false.

	PackageQuerySignal := QuerySignal new.

	PackageQuerySignal nameClass:self message:#packageQuerySignal.

	PackageQuerySignal notifierString:'asking for package'.

	PackageQuerySignal handlerBlock:[:ex | ex proceedWith:(Project isNil 

								    ifTrue:[

									'no package'

								    ] ifFalse:[

									Project currentPackageName

								    ])].

	FileOutNameSpaceQuerySignal := QuerySignal new.

	FileOutNameSpaceQuerySignal defaultAnswer:false.

	ChangeFileAccessLock := Semaphore forMutualExclusion name:'ChangeFileAccessLock'.

    ].

    DefaultApplicationQuerySignal isNil ifTrue:[

	DefaultApplicationQuerySignal := QuerySignal new defaultAnswer:nil.

	DefaultApplicationQuerySignal nameClass:self message:#defaultApplicationQuerySignal.

	DefaultApplicationQuerySignal notifierString:'query for default application'.

	ChangeDefaultApplicationNotificationSignal := QuerySignal new defaultAnswer:nil.

	ChangeDefaultApplicationNotificationSignal nameClass:self message:#changeDefaultApplicationNotificationSignal.

	ChangeDefaultApplicationNotificationSignal notifierString:'change default application'.

    ].

    "

     ClassDescription initialize

    "

    "Created: / 2.4.1997 / 17:27:40 / stefan"

    "Modified: / 17.6.1998 / 10:12:31 / cg"

! !

!ClassDescription class methodsFor:'Signal constants'!

changeDefaultApplicationNotificationSignal

    "return the signal used as an up-Info to change the current application to which

     new classes/methods will be added.

     Will is only used when filing in V'Age code"

    ^ ChangeDefaultApplicationNotificationSignal

    "

     Transcript showCR:Class changeDefaultApplicationNotificationSignal raise

    "

    "Modified: / 5.11.1996 / 20:08:38 / cg"

    "Created: / 15.6.1998 / 18:29:57 / cg"

!

classRedefinitionSignal

    "return the signal raised when a class is about to be redefined

     differently from an existing class and the packages are not

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

     classes from being redefined by incompatible classes

     (classVars, classInstVars or inheritance)."

    ^ ClassRedefinitionSignal

    "Created: / 17.6.1998 / 10:13:44 / cg"

!

createNameSpaceQuerySignal

    "return the signal used as an upQuery if a new nameSpace should be

     silently created without user confirmation.

     Only used when installing autoloaded classes"

    ^ CreateNameSpaceQuerySignal

    "Created: 2.4.1997 / 17:27:54 / stefan"

!

defaultApplicationQuerySignal

    "return the signal used as an upQuery for the current application to which

     new classes/methods are to be added.

     Will is only used when filing in V'Age code"

    ^ DefaultApplicationQuerySignal

    "

     Transcript showCR:Class defaultApplicationQuerySignal raise

    "

    "Modified: / 5.11.1996 / 20:08:38 / cg"

    "Created: / 15.6.1998 / 18:28:54 / cg"

!

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

    "Created: 2.4.1997 / 17:28:03 / stefan"

!

fileOutNameSpaceQuerySignal

    "return the signal used as an upQuery wether the current

     namespace should be prepended on fileOut."

    ^ FileOutNameSpaceQuerySignal

    "

     Transcript showCR:Class fileOutNameSpaceQuerySignal raise

    "

    "Modified: 5.11.1996 / 20:08:38 / cg"

    "Created: 2.4.1997 / 17:28:41 / stefan"

!

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

!

nameSpaceQuerySignal

    "return the signal used as an upQuery for the current nameSpace.

     Will be used when filing in code"

    ^ NameSpaceQuerySignal

    "

     Transcript showCR:Class nameSpaceQuerySignal raise

    "

    "Modified: 5.11.1996 / 20:08:38 / cg"

!

packageQuerySignal

    "return the signal used as an upQuery for the current packages name.

     Will be used when filing in code"

    ^ PackageQuerySignal

    "

     Transcript showCR:Class packageQuerySignal raise

    "

    "Created: 5.11.1996 / 20:07:22 / cg"

    "Modified: 5.11.1996 / 20:08:35 / cg"

!

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

    "

     Transcript showCR:Class updateChangeFileQuerySignal raise

    "

    "Modified: 5.11.1996 / 20:08:44 / cg"

!

usedNameSpaceQuerySignal

    "return the signal used as an upQuery for the used nameSpace.

     Will be used when filing in code"

    ^ UsedNameSpaceQuerySignal

    "Created: 19.12.1996 / 23:57:27 / cg"

! !

!ClassDescription class methodsFor:'accessing - flags'!

catchClassRedefinitions

    "return the class-redefinition catching flag."

    ^ CatchClassRedefinitions

    "Created: / 17.6.1998 / 10:30:01 / cg"

!

catchClassRedefinitions:aBoolean

    "turn on/off class redefinition catching. 

     If on, redefining classes from another package will show a

     warning dialog. Useful, when filing in alien code to avoid defefinition

     of system methods.

     Return the prior value of the flag."

    |prev|

    prev := CatchClassRedefinitions.

    CatchClassRedefinitions := aBoolean.

    ^ prev

    "Created: / 17.6.1998 / 10:31:19 / cg"

!

catchMethodRedefinitions

    "return the method-redefinition catching flag."

    ^ CatchMethodRedefinitions

    "Modified: / 17.6.1998 / 10:30:10 / cg"

!

catchMethodRedefinitions:aBoolean

    "turn on/off method redefinition catching. 

     If on, redefining methods from another package will show a

     warning dialog. Useful, when filing in alien code to avoid defefinition

     of system methods.

     Return the prior value of the flag."

    |prev|

    prev := CatchMethodRedefinitions.

    CatchMethodRedefinitions := aBoolean.

    ^ prev

    "Modified: / 17.6.1998 / 10:31:02 / cg"

!

lockChangesFile

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

    ^ LockChangesFile

!

lockChangesFile:aBoolean

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

    |prev|

    prev := LockChangesFile.

    LockChangesFile := aBoolean.

    ^ prev

! !

!ClassDescription 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]

    "

    "Created: 1.4.1997 / 23:45:09 / stefan"

!

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

    "Created: 1.4.1997 / 23:45:15 / stefan"

! !

!ClassDescription class methodsFor:'queries'!

isBuiltInClass

    "return true if this class is known by the run-time-system.

     Here, true is returned for myself, false for subclasses."

    ^ self == ClassDescription class or:[self == ClassDescription]

    "Created: 15.4.1996 / 17:16:59 / cg"

    "Modified: 23.4.1996 / 15:56:54 / cg"

! !

!ClassDescription methodsFor:'ST80 compatibility'!

organization

    "for ST80 compatibility; 

     read the documentation in ClassOrganizer for more info."

    ^ ClassOrganizer for:self

!

reorganizeFromString:orgString

    "for ST80 compatibility but without functionality"

    "Created: / 28.3.1998 / 21:21:52 / cg"

! !

!ClassDescription methodsFor:'V''Age compatibility'!

categoriesFor:aSelector are:listOfCategories

    "to allow fileIn of V'Age code.

     Set the category of the method which is installed under aSelector.

     Since ST/X only supports a single category, take the first one

     found in the listOfCategories."

    |mthd|

    (mthd := self compiledMethodAt:aSelector) notNil ifTrue:[

	mthd category:listOfCategories first

    ].

    "Created: / 15.6.1998 / 17:11:02 / cg"

    "Modified: / 15.6.1998 / 20:32:28 / cg"

!

commentFor:aSelector is:aString

    "to allow fileIn of V'Age code.

     Set the comment of the method which is installed under aSelector.

     For now, this is ignored"

    |mthd|

    (mthd := self compiledMethodAt:aSelector) notNil ifTrue:[