"

 COPYRIGHT (c) 1995 by AEG Industry Automation

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

"

"{ Package: 'stx:libbasic3' }"

"{ NameSpace: Smalltalk }"

Object subclass:#HistoryManager

	instanceVariableNames:'historyMode fullHistoryUpdate'

	classVariableNames:'TheOneAndOnlyInstance EnforcedUserName'

	poolDictionaries:''

	category:'System-Changes-History'

!

Object subclass:#HistoryLine

	instanceVariableNames:'date time user what firstPositionInSourceCode type'

	classVariableNames:'Quote Separator ModifiedString DeletedString IndentString

		UseGECOS CreatedString AddedString EnforcedUserName

		FormattedString CommentedString VariableRenamedString'

	poolDictionaries:''

	privateIn:HistoryManager

!

!HistoryManager class methodsFor:'documentation'!

copyright 

"

 COPYRIGHT (c) 1995 by AEG Industry Automation

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

"

    This class is part of the HistoryManagerProject.

    It helps to keep track of changes made to methods.

    All Methods and Classes in the system get a HistroyLine which 

    contains a timestamp and the name of the changing user. 

    This is acually the Unix loginname.

    The Manager registers itself to get notifications 

    on change, intercepts them and appends a historyLine to the methods

    code.

    The HistoryManager can be turned on/off from a private.rc script,

    or via the Launcher menu.

    The method's history line is filtered, to only contain one

    entry per modifying user, containing the date of the last change.

    If fullHistoryMode is on, the classes history-ethod is also updated for

    every change (containing every change).

    Full mode is enabled via:

        HistoryManager fullHistoryUpdate:true

    or via the Launchers compilation-settings dialog.

    claus:

        I changed things to avoid depending on every class in the system.

        Now also catch Smalltalk change messages, related to class changes.

    [author:]

        Robert Sailer - AEG

    [see also:]

        HistoryLine

    [start with:]

         HistoryManager activate

         HistoryManager deactivate

"

! !

!HistoryManager class methodsFor:'initialization'!

enforcedUserName

    ^ EnforcedUserName

!

enforcedUserName:aStringOrNil

    EnforcedUserName := aStringOrNil

    "

     self enforcedUserName:'fm'

     self enforcedUserName:nil

    "

!

initMe

    "setup theOneAndOnly instance of myself (if not already present"

    ^self new.

    "Modified: 14.8.1995 / 09:02:00 / robert"

    "Modified: 20.4.1996 / 20:33:44 / cg"

!

initialize

    "add myself as a dependent of ObjectMemory to be told about image restarts"

    ObjectMemory addDependent: self.

    "Modified: / 14-08-1995 / 09:09:06 / robert"

    "Modified: / 05-07-2006 / 17:36:47 / cg"

! !

!HistoryManager class methodsFor:'instance creation'!

new

    "because there can be only ONE HistoryManager, new must me redefiend"

    TheOneAndOnlyInstance isNil ifTrue:[

        TheOneAndOnlyInstance := self basicNew initialize.

        HistoryLine initialize.

    ].

   ^ TheOneAndOnlyInstance

"

    HistoryManager new.

"

    "Modified: / 11-08-1995 / 17:01:29 / robert"

    "Modified: / 04-12-2011 / 08:54:22 / cg"

! !

!HistoryManager class methodsFor:'accessing'!

fullHistoryUpdate

    "return true, if the historyManagement does full updates"

    TheOneAndOnlyInstance isNil ifTrue:[^ false].

    ^ TheOneAndOnlyInstance fullHistoryUpdate

    "Modified: / 27.8.1995 / 00:32:12 / claus"

    "Created: / 24.10.1997 / 02:24:34 / cg"

    "Modified: / 29.10.1997 / 15:48:22 / cg"

!

fullHistoryUpdate:aBoolean

    "set/clear, full updates"

    TheOneAndOnlyInstance isNil ifTrue:[^ self].

    TheOneAndOnlyInstance fullHistoryUpdate:aBoolean

    "Modified: / 27.8.1995 / 00:32:12 / claus"

    "Created: / 24.10.1997 / 02:24:58 / cg"

    "Modified: / 29.10.1997 / 15:48:36 / cg"

!

instance

    "return the one and only historyManager instance"

    ^ TheOneAndOnlyInstance

    "Modified: 20.4.1996 / 20:31:18 / cg"

!

isActive 

    "return true, if the historyManagement is activated"

    ^ TheOneAndOnlyInstance notNil

    "Modified: 27.8.1995 / 00:32:12 / claus"

    "Modified: 20.4.1996 / 20:31:32 / cg"

! !

!HistoryManager class methodsFor:'activation / deactivation'!

activate

    "activate the HistoryManagement"

    self new   "/ creating an instance activates me

    "

     HistoryManager activate

    "

    "Modified: 20.4.1996 / 20:31:46 / cg"

!

deactivate

    "deactivate the HistoryManagement"

    |mgr|

    mgr := TheOneAndOnlyInstance.

    mgr notNil ifTrue:[

        mgr releaseDependencies.

    ].

    TheOneAndOnlyInstance := nil.

    "

     HistoryManager deactivate

    "

    "Modified: 8.1.1997 / 23:09:08 / cg"

! !

!HistoryManager class methodsFor:'change & update'!

update:what with:aParameter from:changedObject

    "intercepts system restart - reinstall mySelf as dependent of all classes"

    (what == #restarted) ifTrue:[

        TheOneAndOnlyInstance notNil ifTrue:[

            "

             smalltalk is about to restart from an Image -

            "

"/            'HistoryManager initialize (via update)' infoPrintNL.

            self initMe.

        ]

    ].

    "Modified: 27.8.1995 / 16:33:02 / claus"

    "Modified: 20.4.1996 / 20:33:02 / cg"

    "Created: 15.6.1996 / 15:25:53 / cg"

! !

!HistoryManager class methodsFor:'helpers'!

codeForInitialHistoryMethodIn:aClass

    "create an initial (empty) history method"

    |histStream|

    histStream := '' writeStream.

    histStream nextPutLine:'history'.

    histStream nextPutLine:(HistoryLine newCreated printString).

    ^ histStream contents

!

createInitialHistoryMethodIn:aClass

    <resource: #obsolete>

    "create an initial (empty) history method"

    self obsoleteMethodWarning.

    SmalltalkCodeGeneratorTool

        compile:(self codeForInitialHistoryMethodIn:aClass)

        forClass:aClass 

        inCategory:'documentation'.

    "Created: / 24-10-1997 / 02:41:43 / cg"

    "Modified: / 31-01-2011 / 18:28:51 / cg"

!

getAllHistoriesFrom:someString

    "returns anArray of HistoryLines from a string.

     Usually, the argument is a methods source code."

    |position aReadWriteStream firstFound nextFound  aHistoryString rcOC h|

    rcOC := OrderedCollection new.

    someString isNil ifTrue:[

        ^ rcOC

    ].

    "read begining from the end and look there for the first comment character. If there's none return"

    position := someString size.

    firstFound := false.

    nextFound := false.

    someString reverseDo:[ :aChar|

        position := position - 1.

        aChar == $" ifTrue:[

            firstFound ifTrue:[

                firstFound := false.

                nextFound := true.

            ] ifFalse:[

                aReadWriteStream := ReadWriteStream on: (someString species) new.

                firstFound := true.

                nextFound := false.

            ].

        ].

        (firstFound and: [nextFound not]) ifTrue:[

            "now collect all up to the next comment character"

            aChar == $" ifFalse:[     

                aReadWriteStream nextPut: aChar.

            ].

        ].

        nextFound ifTrue:[

            "End reached - now try to make a HistoryLine"

            aHistoryString := (aReadWriteStream contents) reverse.

            "

                Transcript showCR: aHistoryString.

            "

            h := HistoryLine fromString: aHistoryString at: position.

            h notNil ifTrue:[

                rcOC add:h.

            ].

"/            (aHistoryString startsWith: 'Modified:') ifTrue:[

"/                "a history line was found - now make a NewInstance of HistoryLine"

"/                rcOC add: ( HistoryLine fromString: aHistoryString at: position).

"/            ].

            nextFound := false.

        ].

    ].

    ^rcOC reverse  "the OrderedCollection with HistoryLines in the right order"

    "Modified: / 21-12-1993 / 18:32:30 / M.Noell"

    "Modified: / 09-08-1995 / 22:45:30 / R.Sailer"

    "Modified: / 08-09-1995 / 17:54:33 / claus"

    "Modified: / 18-09-2006 / 20:48:19 / cg"

!

getLastHistoryLineFrom:someString

    "returns the last HistoryLine, if no HistoryLine available, return nil"

    |hist|

    hist := self getAllHistoriesFrom: someString.

    hist isEmpty ifTrue: [ ^ nil].

    ^ hist last

    "Created: 19.1.1996 / 13:08:57 / werner"

!

withoutHistoryLines:someString

    "given some methods sourceString, return a copy without any

     history lines"

    | pos sourceCode previousHistories |

    someString isNil ifTrue:[^ someString].

    previousHistories := self getAllHistoriesFrom:someString.

    "extract source body."

    previousHistories isEmpty ifTrue: [

        sourceCode := someString withoutSeparators.

    ] ifFalse: [

        pos := (previousHistories first) firstPositionInSourceCode.

        sourceCode := (someString copyFrom: 1 to: pos - 1) withoutSeparators.

    ].

    ^ sourceCode

    "

     HistoryManager withoutHistoryLines:nil  

     HistoryManager withoutHistoryLines:''  

     HistoryManager 

        withoutHistoryLines:(HistoryManager class 

                                compiledMethodAt:#withoutHistoryLines:) source

    "

    "Created: 5.3.1996 / 15:11:12 / cg"

    "Modified: 30.4.1996 / 10:57:35 / cg"

! !

!HistoryManager methodsFor:'accessing'!

fullHistoryUpdate

    "return the fullHistoryUpdate; 

     if true, the classes history method is also updated."

    ^ fullHistoryUpdate

    "Modified: 11.08.1995 / 16:52:12 / robert"

!

fullHistoryUpdate:aBoolean

    "set the fullHistoryUpdate; 

     if true, the classes history method is also updated."

    fullHistoryUpdate := aBoolean.

    "Modified: 11.08.1995 / 16:52:12 / robert"

!

historyMode

    "return historyMode"

    ^ historyMode

    "Modified: 11.08.1995 / 16:51:56 / robert"

!

historyMode:something

    "set historyMode"

    historyMode := something.

    "Modified: 11.08.1995 / 16:52:12 / robert"

! !

!HistoryManager methodsFor:'change & update'!

update:something with:someArgument from:changedObject

    "arrive here, whenever any class changed somehow.

     (something contains aSymbol describing what happened)"

    |selector oldMethod changedClass whatChange|

    something == #methodCoverageInfo ifTrue:[^ self].

    something == #methodTrap ifTrue:[^ self].

    "/

    "/ no action, if disabled

    "/

    historyMode ifFalse:[

        ^ self

    ].

    "/

    "/ no action, if changeFile update is locked

    "/ (since then, this may be a recompile or fileIn)

    "/

    (Class updateChangeFileQuerySignal query) ifFalse:[ 

"/        Transcript showCR: '* noChange in history'. 

        ^ self 

    ].

    Class updateHistoryLineQuerySignal query ifFalse:[ 

"/        Transcript showCR: '* noChange in history'. 

        ^ self 

    ].

    "                  

     definition, instance / classVariables of a class have changed

    "

    (something == #definition) ifTrue:[

        "/ it is a class definition that has changed

        "/ add a line to the history method; if present

        self updateAfterClassChange:'class definition' in:changedObject.

        ^ self

    ].

    "this is a sub item of #definition"    

    (something == #classVariables) ifTrue:[

        self updateAfterClassChange:'class variables' in:changedObject.

        ^ self

    ].    

    "/

    "/ new Class creation

    "/

    ((changedObject == Smalltalk) and:[something == #newClass]) ifTrue:[

        "/ 

        "/  add myself as dependents in order to get future change notifications

        "/ 

        fullHistoryUpdate == true ifTrue:[

            someArgument theMetaclass compilerClass == Compiler ifFalse:[^ self].

            self createHistoryMethodFor:someArgument.

            self addHistory:#creation with:nil toHistoryMethodOf:someArgument.

        ].

        "/ claus: old implementation

"/        someArgument addDependent: self.

"/        someArgument class addDependent: self.   "for class methods"

        ^ self

    ].

    "/ changed methods

    "/ for backward compatibility, still handle the

    "/ classes own change notification.

    "/ (only if I am a dependent of all classes)

    changedObject isBehavior ifTrue:[

        changedClass := changedObject.

        changedClass theMetaclass compilerClass == Compiler ifFalse:[^ self].

        something == #methodDictionary ifTrue:[

            whatChange := #methodDictionary.

            someArgument isArray ifTrue:[

                selector := someArgument at:1.

                oldMethod := someArgument at:2

            ] ifFalse:[