"

 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.

"

ClassDescription subclass:#Class

	instanceVariableNames:'classvars comment subclasses classFilename package revision hook'

	classVariableNames:'UpdatingChanges LockChangesFile FileOutErrorSignal

		CatchMethodRedefinitions MethodRedefinitionSignal

		UpdateChangeFileQuerySignal TryLocalSourceFirst

		ChangeFileAccessLock NameSpaceQuerySignal PackageQuerySignal

		UsedNameSpaceQuerySignal CreateNameSpaceQuerySignal OldMethods'

	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.

"

!

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

    [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

        hook            <any>           reserved: a place to add additional attributes,

                                        without a need to recompile all classes.

                                        Currently unused.

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

        OldMethods                      if nonNil, this must be an IdentityDictionary,

                                        which is filled with method->previousversionMethod

                                        associations. Can be used for undo-last-method-change

                                        Notice: this may fillup your memory over time.

    WARNING: layout known by compiler and runtime system

    [author:]

        Claus Gittinger

    [see also:]

        Behavior ClassDescription Metaclass

"

! !

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

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

        NameSpaceQuerySignal := QuerySignal new mayProceed:true.

        NameSpaceQuerySignal nameClass:self message:#nameSpaceQuerySignal.

        NameSpaceQuerySignal notifierString:'asking for nameSpace'.

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

        UsedNameSpaceQuerySignal := QuerySignal new mayProceed:true.

        UsedNameSpaceQuerySignal nameClass:self message:#usedNameSpaceQuerySignal.

        UsedNameSpaceQuerySignal notifierString:'asking for used nameSpaced'.

        UsedNameSpaceQuerySignal handlerBlock:[:ex | ex proceedWith:nil].

        CreateNameSpaceQuerySignal := QuerySignal new mayProceed:true.

        CreateNameSpaceQuerySignal nameClass:self message:#createNameSpaceQuerySignal.

        CreateNameSpaceQuerySignal notifierString:'asking for nameSpace creation'.

        CreateNameSpaceQuerySignal handlerBlock:[:ex | ex proceedWith:false].

        PackageQuerySignal := QuerySignal new mayProceed:true.

        PackageQuerySignal nameClass:self message:#packageQuerySignal.

        PackageQuerySignal notifierString:'asking for package'.

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

                                                                    ifTrue:[

                                                                        'no package'

                                                                    ] ifFalse:[

                                                                        Project currentPackageName

                                                                    ])].

        ChangeFileAccessLock := Semaphore forMutualExclusion.

    ]

    "Modified: 19.12.1996 / 23:49:57 / cg"

! !

!Class 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: 7.11.1996 / 12:55:01 / 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

!

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"

! !

!Class class methodsFor:'accessing - flags'!

catchMethodRedefinitions

    "return the redefinition catching flag."

    ^ CatchMethodRedefinitions

!

catchMethodRedefinitions:aBoolean

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

    |prev|

    prev := CatchMethodRedefinitions.

    CatchMethodRedefinitions := aBoolean.

    ^ prev

!

keepMethodHistory:aBoolean

    "turn on/off oldMethod remembering. If on, a methods previous version

     is kept locally, for later undo (or compare)."

    aBoolean ifTrue:[

        OldMethods isNil ifTrue:[

            OldMethods := IdentityDictionary new.

        ]

    ] ifFalse:[

        OldMethods := nil

    ].

    "

     Class keepMethodHistory:true

     Class keepMethodHistory:false

    "

    "Modified: 7.11.1996 / 18:36:00 / cg"

    "Created: 7.11.1996 / 19:05:57 / 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

!

tryLocalSourceFirst

    ^ TryLocalSourceFirst

    "Created: 24.1.1996 / 19:55:35 / cg"

!

tryLocalSourceFirst:aBoolean

    TryLocalSourceFirst := aBoolean

    "Created: 24.1.1996 / 19:55:35 / cg"

!

updateChanges:aBoolean

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

     This value is used as a default fallback - a querySignal handler may still 

     decide to return something else."

    |prev|

    prev := UpdatingChanges.

    UpdatingChanges := aBoolean.

    ^ prev

!

updatingChanges

    "return true if changes are recorded.

     The value returned here is the default fallback - a querySignal handler may still

     decide to return something else."

    ^ UpdatingChanges

! !

!Class class methodsFor:'accessing - history'!

flushMethodHistory

    "flush any method->previousVersion associations,

     all history is lost."

    OldMethods notNil ifTrue:[

        OldMethods := IdentityDictionary new

    ].

    "Created: 7.11.1996 / 19:07:25 / cg"

!

methodHistory

    "return a dictionary containing method->previousVersion associations,

     nil if method remembering has been turned off"

    ^ OldMethods 

    "

     Class oldMethods

    "

    "Modified: 7.11.1996 / 18:36:00 / cg"

    "Created: 7.11.1996 / 19:06:28 / cg"

! !

!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 class methodsFor:'helpers'!

revisionInfoFromString:aString

    "{ Pragma: +optSpace }"

    "return a dictionary filled with revision info.

     This extracts the relevant info from aString.

     For now, this is a bad design - should always ask the

     SCM to extract the parts (knowing about the details of RCS headers

     here is a bad design ...)"

    |words info nm mgr|

    info := IdentityDictionary new.

    words := aString asCollectionOfWords.

    words notEmpty ifTrue:[

        "/

        "/ supported formats:

        "/

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

        "/ $-Revision: rev $

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

        "/

        ((words at:1) = '$Header:') ifTrue:[

            nm := words at:2.

            info at:#repositoryPathName put:nm.

            (nm endsWith:',v') ifTrue:[

                nm := nm copyWithoutLast:2

            ].

            info at:#fileName put:nm asFilename baseName.

            words size > 2 ifTrue:[

                (words at:3) = '$' ifFalse:[

                    info at:#revision put:(words at:3).

                    (words at:4) = '$' ifFalse:[

                        info at:#date put:(words at:4).

                        info at:#time put:(words at:5).

                        info at:#user put:(words at:6).

                        info at:#state put:(words at:7).

                    ]

                ].

            ].

            ^ info

        ].

        ((words at:1) = '$Revision:') ifTrue:[

            info at:#revision put:(words at:2).

            ^ info

        ].

        ((words at:1) = '$Id:') ifTrue:[

            info at:#fileName put:(words at:2).

            info at:#revision put:(words at:3).

            info at:#date put:(words at:4).

            info at:#time put:(words at:5).

            info at:#user put:(words at:6).

            info at:#state put:(words at:7).

            ^ info

        ].

    ].

    "/

    "/ mhmh - maybe its some other source code system

    "/

    (mgr := Smalltalk at:SourceCodeManager) notNil ifTrue:[

        ^ mgr revisionInfoFromString:aString