"

 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

		UpdateChangeFileQuerySignal TryLocalSourceFirst

		ChangeFileAccessLock NameSpaceQuerySignal PackageQuerySignal

		UsedNameSpaceQuerySignal CreateNameSpaceQuerySignal

		FileOutNameSpaceQuerySignal'

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

    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.

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

    ]

    "Modified: 3.1.1997 / 15:16:05 / cg"

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

! !

!ClassDescription class methodsFor:'Signal constants'!

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"

!

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"

! !

!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:'accessing'!

category

    ^ self subclassResponsibility

    "Created: 2.4.1997 / 00:51:04 / stefan"

!

comment

    ^ self subclassResponsibility

    "Created: 2.4.1997 / 00:51:11 / stefan"

!

instVarAtOffset:index

    "return the name of the instance variable at index"

    ^ self allInstanceVariableNames at:index

!

instVarNames

    "return a collection of the instance variable name-strings"

    instvars isNil ifTrue:[

	^ OrderedCollection new

    ].

    ^ instvars asCollectionOfWords

    "

     Point instVarNames  

    "

!

instVarOffsetOf:aVariableName

    "return the index (as used in instVarAt:/instVarAt:put:) of a named instance

     variable. The returned number is 1..instSize for valid variable names, nil for

     illegal names."

    ^ self allInstVarNames lastIndexOf:aVariableName ifAbsent:nil

    "Modified: 7.4.1997 / 16:59:39 / cg"

!

instanceVariableOffsets

    "returns a dictionary containing the instance variable index

     for each instVar name"

    |dict index|

    index := 0. dict := Dictionary new.

    self allInstVarNames do:[:nm | index := index + 1. dict at:nm put:index].

    ^ dict

    "

     Point instanceVariableOffsets 

     GraphicsContext instanceVariableOffsets 

    "

!

instanceVariableString

    "return a string of the instance variable names"

    instvars isNil ifTrue:[^ ''].

    ^ instvars

    "

     Point instanceVariableString   

    "

!

name

    ^ self subclassResponsibility

    "Created: 2.4.1997 / 00:50:56 / stefan"

!

organization

    "for ST80 compatibility; 

     read the documentation in ClassOrganizer for more info."

    ^ ClassOrganizer for:self

!

renameCategory:oldCategory to:newCategory

    "{ Pragma: +optSpace }"

    "rename a category (changes category of those methods).

     Appends a change record and notifies dependents."

    |any|

    any := false.

    self methodDictionary do:[:aMethod |

        aMethod category = oldCategory ifTrue:[

            aMethod category:newCategory.

            any := true.

        ]

    ].

    any ifTrue:[

        self addChangeRecordForRenameCategory:oldCategory to:newCategory.

        self changed:#methodCategory.

    ]

    "Modified: 12.6.1996 / 11:49:08 / stefan"

    "Created: 3.6.1997 / 11:55:05 / cg"

! !

!ClassDescription methodsFor:'adding/removing'!

addSelector:newSelector withMethod:newMethod

    "add the method given by 2nd argument under the selector given by

     1st argument to the methodDictionary. 

     Append a change record to the changes file and tell dependents."

    |oldMethod|

    oldMethod := self compiledMethodAt:newSelector.

    CatchMethodRedefinitions ifTrue:[

        "check for attempts to redefine a method

         in a different package. Signal a resumable error if so.

         This allows tracing redefinitions of existing system methods

         when filing in alien code ....

         (which we may want to forbit sometimes)

        "

        oldMethod notNil ifTrue:[

            oldMethod package ~= newMethod package ifTrue:[

                "

                 attempt to redefine an existing method, which was

                 defined in another package.

                 If you continue in the debugger, the new method gets installed.

                 Otherwise, the existing (old) method remains valid.

                 You can turn of the catching of redefinitions by setting

                   CatchMethodRedefinitions to false

                 (also found in the Launchers 'settings-misc' menu)

                "

                (MethodRedefinitionSignal

                    raiseRequestWith:(oldMethod -> newMethod)

                    errorString:('redefinition of ' , self name , '>>' , newSelector) 

                ) == #keep ifTrue:[

                    newMethod package:oldMethod package

                ].

                "/ if proceeded, install as usual.

            ]

        ]

    ].

    "/ remember new->old association in the OldMethods dictionary (if non-nil)

    OldMethods notNil ifTrue:[

        oldMethod notNil ifTrue:[

"/            oldMethod source:(oldMethod source).

            OldMethods at:newMethod put:oldMethod

        ]

    ].

    "/ remember in the projects overwritten dictionary

    oldMethod notNil ifTrue:[

        oldMethod package ~= newMethod package ifTrue:[

            Project notNil ifTrue:[

                "/ allow configurations without Project

                Project rememberOverwrittenMethod:newMethod from:oldMethod

            ]

        ]

    ].

    (super addSelector:newSelector withMethod:newMethod) ifTrue:[

        self addChangeRecordForMethod:newMethod.

    ]

    "Modified: 9.9.1996 / 22:39:32 / stefan"

    "Modified: 4.6.1997 / 14:47:06 / cg"

    "Created: 4.6.1997 / 14:47:10 / cg"

!

basicAddSelector:newSelector withMethod:newMethod

    "add the method given by 2nd argument under the selector given by

     1st argument to the methodDictionary. 

     This does NOT append a change record to the changes file and tell 

     dependents. Also, no methodHistory is kept or redefinition is checked."

    super addSelector:newSelector withMethod:newMethod

    "Created: 2.4.1997 / 01:01:08 / stefan"

!

removeSelector:aSelector

    "remove the selector, aSelector and its associated method 

     from the methodDictionary.

     Append a change record to the changes file and tell dependents."

    (super removeSelector:aSelector) ifTrue:[

        self addChangeRecordForRemoveSelector:aSelector.

        "/

        "/ also notify a change of mySelf;

        "/

        self changed:#methodDictionary with:aSelector.

        "/

        "/ also notify a change of Smalltalk;

        "/ this allows a dependent of Smalltalk to watch all class

        "/ changes (no need for observing all classes)

        "/ - this allows for watchers to find out if its a new method or a method-change

        "/

        Smalltalk changed:#methodInClassRemoved with:(Array with:self with:aSelector).

    ]

    "Modified: 8.1.1997 / 23:03:49 / cg"

    "Created: 2.4.1997 / 00:59:29 / stefan"

! !

!ClassDescription methodsFor:'c function interfacing'!

cInterfaceFunction:selector calling:cFunctionNameString args:argTypeArray returning:returnType

    "{ Pragma: +optSpace }"

    "create an interface to an existing (i.e. already linked in) c function.

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

    StubGenerator isNil ifTrue:[

        ^ self error:'this system does not support dynamic C Interface functions'.

    ].

    StubGenerator 

        createStubFor:selector 

        calling:cFunctionNameString