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

Object subclass:#HistoryManager
	instanceVariableNames:'historyMode fullHistoryUpdate'
	classVariableNames:'TheOneAndOnlyInstance'
	poolDictionaries:''
	category:'System-Changes-History'
!

!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 all Classes in the system to get notifications 
    on change, intercepts them and appends a historyLine to the methods
    code.

    The HistoryManager can be turned off via the Launcher menu.

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

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.8.1995 / 09:09:06 / robert"
    "Modified: 20.4.1996 / 20:34:09 / cg"
! !

!HistoryManager class methodsFor:'instance creation'!

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

    TheOneAndOnlyInstance isNil ifTrue:[
	TheOneAndOnlyInstance := super new initialize.
	HistoryLine initialize.
    ].

   ^ TheOneAndOnlyInstance

"

    HistoryManager new.
"

    "Modified: 11.08.1995 / 17:01:29 / robert"
! !

!HistoryManager class methodsFor:'accessing'!

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

getAllHistoriesFrom:someString
    "returns anArray of HistoryLines from a string.
     Usually, the argument is a methods source code."

    |position aReadWriteStream firstFound nextFound  aHistoryString rcOC h|

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

    rcOC := OrderedCollection new.
    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: String 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: 9.8.1995 / 22:45:30 / R.Sailer"
    "Modified: 8.9.1995 / 17:54:33 / claus"
    "Modified: 20.4.1996 / 20:33:22 / cg"
!

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

    |sourceCode newMethod fileInOrRecompiling selector oldMethod what
     changedClass whatChange|

    "/
    "/ no action, if disabled
    "/
    historyMode ifFalse:[
        ^ self
    ].

    "/
    "/ no action, if changeFile update is locked
    "/ (since then, this may be a recompile or fileIn)
    "/
    fileInOrRecompiling := Class updateChangeFileQuerySignal raise.
    fileInOrRecompiling 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

"/        Transcript show: 'Class definition: ', changedClass printString;cr.
        fullHistoryUpdate == true ifTrue:[
            self addHistory:#modification toHistoryMethodOf:changedClass.
        ].
        ^ self
    ].

    "this is a sub item of #definition"    
    (something == #classVariables) ifTrue:[
        "/
        "/ Transcript showCR: 'classVariables changed'.
        "/

        "/ does not yet work;
        "/ (someArgument does not contain the class we are interested in)

        fullHistoryUpdate == true ifTrue:[
            self addHistory:#modification toHistoryMethodOf: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:[
            self createHistoryMethodFor:someArgument.
            self addHistory:#creation 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.

        something == #methodDictionary ifTrue:[
            whatChange := #methodDictionary.

            someArgument isArray ifTrue:[
                selector := someArgument at:1.
                oldMethod := someArgument at:2
            ] ifFalse:[
                selector := someArgument
            ].
        ].

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

        something == #comment ifTrue:[
            whatChange := #comment.
        ].
    ].

    "/ the new mechanism; I only need to depend upon
    "/ Smalltalk, to get all method changes

    (changedObject == Smalltalk
    and:[something == #methodInClass]) ifTrue:[
        changedClass := someArgument at:1.
        selector := someArgument at:2.
        oldMethod := someArgument at:3.
        whatChange := #methodDictionary.
    ].

    changedClass notNil ifTrue:[
        whatChange == #methodDictionary ifTrue:[
            "/ ok; it is a changed method

            "/
            "/ fetch sourceString of the method
            "/
            sourceCode := changedClass sourceCodeAt:selector.
            sourceCode isNil ifTrue:[
                "method has been deleted"
"/                Transcript showCR: 'method has been deleted'.
            ] ifFalse:[
                newMethod := changedClass compiledMethodAt:selector.

                oldMethod notNil ifTrue:[
                    (oldMethod source asString withTabsExpanded = sourceCode asString withTabsExpanded) ifTrue:[
                         "/ no change (accepted same code again ?)
                        ^ self
                    ].
                ].

                "/
                "/ dont add historylines to documentation methods ...
                "/
                (changedClass isMeta not
                or:[newMethod category ~= 'documentation']) ifTrue:[
                    oldMethod notNil ifTrue:[
                        what := #modification
                    ] ifFalse:[
                        what := #creation
                    ].

                    "/
                    "/ update the history line-comment in
                    "/ the methods source
                    "/
                
                    sourceCode := self addHistory:what to:sourceCode.
                    newMethod source: sourceCode.
"/                    Transcript showCR: 'history updated / added'.
                ]
            ].
            ^self
        ]. 

        whatChange == #comment ifTrue:[
            "the classes comment - we are no longer interrested in that one"

            ^ self.
        ].

        whatChange == #classDefinition ifTrue:[
            "/ it is a class definition that has changed
            "/ add a line to the history method; if present

"/            Transcript show: 'Class definition: ', changedClass printString;cr.
            fullHistoryUpdate == true ifTrue:[
                self addHistory:#modification toHistoryMethodOf:changedClass.
            ].
            ^self
        ].
    ].
"/    Transcript show: 'unhandled change: ', something printString;cr.

    ^self

    "Modified: 27.8.1995 / 02:14:43 / claus"
    "Modified: 9.1.1997 / 02:27:28 / cg"
! !

!HistoryManager methodsFor:'initialization'!

exclude
    "public - return an exclusionlist for some smalltalk classes which should not be notified or historisized"

    | oc |
        
    oc := OrderedCollection new.
    oc add: self.

    ^oc

    "Modified: 11.08.1995 / 17:02:18 / robert"
!

initialize
    "public - make me depend on all smalltalk classes (except the exclusionList)
     to be notified later about changes. This intercepts source installation and allows
     be to patch the source-string with a historyLine."

    |exclusionlist|

    super initialize.
    historyMode := true.
    fullHistoryUpdate := false.
    exclusionlist := self exclude.

    "/ old implementation:
    "/ made myself a dependent of all classes ...

"/    Smalltalk allClassesDo:[:aClass|
"/        "all classes should send a notification if changed"
"/        "aClass = self " false ifFalse: [
"/            (exclusionlist includes: aClass) ifFalse:[
"/                aClass addDependent: self.
"/                aClass class addDependent: self.   "for class methods"
"/            ].
"/        ].
"/    ].

    "/ old implementation:
    "/ Smalltalk also sends class-change notifications ...

    Smalltalk addDependent:self.

    ^self

    "Modified: 11.8.1995 / 17:12:51 / robert"
    "Modified: 8.1.1997 / 23:07:14 / cg"
!

releaseDependencies
    "no longer depend on class changes"

    "/ old implementation:
    "/ made myself a dependent of all classes ...

"/    Smalltalk allClassesDo:[:aClass |
"/        aClass removeDependent:self.
"/        aClass class removeDependent:self.
"/    ].

    "/ new implementation:
    "/ Smalltalk also sends class-change notifications ...

    Smalltalk removeDependent:self.
! !

!HistoryManager methodsFor:'updateHistory'!

addHistory:what to:someString
    "private - add a historyLine at end to the sourceCode;
     check for multiple lines of the same user and merge into one.
     What may be one of #modification or #creation, to choose among
     'Modified' or 'Created' lines."

    | histLines pos wStream sourceCode previousHistories
      newLine |

    "Check whether we want a history to be added"    
    historyMode ifFalse:[
        ^ someString
    ].

    previousHistories := self class getAllHistoriesFrom:someString.

    what == #creation ifTrue:[
        newLine := (HistoryLine newCreated).
    ] ifFalse:[
        newLine := (HistoryLine new)
    ].

    "extract source body."
    previousHistories isEmpty ifTrue: [
        sourceCode := someString withoutSeparators.
    ] ifFalse: [
        pos := (previousHistories first) firstPositionInSourceCode.
        sourceCode := (someString copyFrom: 1 to: pos - 1) withoutSeparators.
    ].

    "add the actual user's historyLine."
    previousHistories add:newLine.

    "Filtering historyLines (each user with one entry)."
    histLines := HistoryLine filterHistoryLines: previousHistories.

    "create new body with added historyLine"
    wStream := WriteStream on: String new.
    wStream nextPutAll: sourceCode; cr.

    "append the historyLines to the source"
    wStream cr.
    histLines do: [:hl |
       wStream nextPutLine:hl printString.
    ].

    ^ wStream contents.

    "Modified: 11.8.1995 / 16:51:50 / robert"
    "Modified: 8.9.1995 / 17:55:38 / claus"
    "Created: 12.10.1996 / 20:33:35 / cg"
    "Modified: 9.11.1996 / 00:41:51 / cg"
!

addHistory:what toHistoryMethodOf:aClass
    "private - add a historyLine at end of the classes history methods
     source - if there is one"

    |cls historyMethod oldSource newSource|

    aClass isMeta ifFalse:[
        cls := aClass class.
    ] ifTrue:[
        cls := aClass
    ].
    historyMethod := cls compiledMethodAt: #history.
    historyMethod notNil ifTrue:[
        oldSource := historyMethod source.
        oldSource notNil ifTrue:[
            newSource := self 
                            addHistory:what
                            to:oldSource. 
            historyMethod source:newSource.
        ]
    ]

    "Modified: 20.4.1996 / 20:35:06 / cg"
    "Created: 12.10.1996 / 20:31:50 / cg"
!

createHistoryMethodFor:aClass
    "private - create a history method"

    |cls|

    aClass isMeta ifFalse:[
        cls := aClass class.
    ] ifTrue:[
        cls := aClass
    ].

    Class updateChangeFileQuerySignal answer:false do:[
        Compiler
            compile:'history' 
            forClass:cls 
            inCategory:'documentation'
    ].

    "Modified: 14.10.1996 / 16:58:20 / cg"
! !

!HistoryManager class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic3/HistoryManager.st,v 1.34 1997-01-09 01:29:05 cg Exp $'
! !
HistoryManager initialize!