"

 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'

	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

"

    Author: Robert Sailer - AEG

"

!

examples

"

    HistoryManager new

"

    "Modified: 11.08.1995 / 16:50:47 / robert"

! !

!HistoryManager class methodsFor:'initialization'!

initMe

    ^self new.

!

initialize

    ObjectMemory addDependent: self.

! !

!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

!

isActive 

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

! !

!HistoryManager class methodsFor:'activation / deactivation'!

activate

    self new   "/ creating an instance activates me

    "

     HistoryManager activate

    "

!

deactivate

    |mgr|

    mgr := TheOneAndOnlyInstance.

    Smalltalk allClassesDo:[:aClass |

    ].

    TheOneAndOnlyInstance := nil.

    "

     HistoryManager deactivate

    "

! !

!HistoryManager class methodsFor:'change and update'!

update: what

    (what == #restarted) ifTrue:[

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

    ].

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

! !

!HistoryManager class methodsFor:'helpers'!

getAllHistoriesFrom:someString

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

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

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

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

"/            ].

    ].

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

!

withoutHistoryLines:someString

    "given some methods sourceString, return a copy without any

     history lines"

    | pos sourceCode previousHistories |

    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

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

    "Modified: 6.3.1996 / 11:52:21 / cg"

! !

!HistoryManager methodsFor:'accessing'!

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

    exclusionlist := self exclude.

    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"

	    ].

	].

    ].

    ^self

    "Modified: 11.08.1995 / 17:12:51 / robert"

! !

!HistoryManager methodsFor:'updateHistory'!

addHistoryTo:someString forceModification:forceModification forceCreation:forceCreation

    "private - add a historyLine at end to the sourceCode;

     check for multiple lines of the same user and merge into one.

     If forceModification is true or a history already exists in someString,

     add a 'Modified' line; otherwise, add a 'Created' line."

    | histLines pos wStream sourceCode previousHistories

      newLine |

    "Check whether we want a history to be added"    

    historyMode ifFalse:[

	^ someString

    ].

    previousHistories := self class getAllHistoriesFrom:someString.

    "extract source body."

    previousHistories isEmpty ifTrue: [

	sourceCode := someString withoutSeparators.

	forceModification ifTrue:[

	    newLine := (HistoryLine new)

	] ifFalse:[

	    newLine := (HistoryLine newCreated).

	]

    ] ifFalse: [

	pos := (previousHistories first) firstPositionInSourceCode.

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

	forceCreation ifTrue:[

	    newLine := (HistoryLine newCreated).

	] ifFalse:[

	    newLine := (HistoryLine new)

	]

    ].

    "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 nextPutAll:hl printString; cr.

    ].

    ^wStream contents.

    "Modified: 11.8.1995 / 16:51:50 / robert"

    "Modified: 8.9.1995 / 17:55:38 / claus"

    "Modified: 13.12.1995 / 14:07:03 / cg"

!

addHistoryToHistoryMethodOf:aClass

    |cls historyMethod oldSource newSource|

    aClass isMeta ifFalse:[

    ] ifTrue:[

    ].

    historyMethod := cls compiledMethodAt: #history.

    historyMethod notNil ifTrue:[

    ]

!

update:something with:someArgument from:changedObject

    "arrive here, whenever any class changed somehow.

     (something contains aSymbol describing what happened)"

    | sourceCode newMethod fileInOrRecompiling selector oldMethod|

"/    changedObject == self ifTrue:[  "for development only"

"/        self halt.

"/        ^self.

"/    ].

    fileInOrRecompiling := Class updateChangeFileQuerySignal raise.

"/    changedObject isMeta ifTrue:[

"/        Transcript showCr: 'metaClass = ',  changedObject printString.

"/    ].

    fileInOrRecompiling ifFalse:[ 

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

	^ self 

    ].

    historyMode ifFalse:[

	^ self

    ].

    "

    Class Variables

    "

    (something == #definition) ifTrue:[

	"add handling for classes here ..."        

	"/ self addHistoryToHistoryMethodOf:changedObject.

    ].

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

	self addHistoryToHistoryMethodOf:changedObject.

	^ self

    ].    

    "

     new Class creation

    "

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

	"/ 

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

	"/ 

	someArgument addDependent: self.

	someArgument class addDependent: self.   "for class methods"

	someArgument history:(self addHistoryTo:String new forceModification:false forceCreation:false).  "append historyString for new class"

    ].

    "

     changed methods

    "

    changedObject isBehavior ifTrue:[

	something = #methodDictionary ifTrue:[

	    someArgument isArray ifTrue:[

		selector := someArgument at:1.

		oldMethod := someArgument at:2

	    ] ifFalse:[

		selector := someArgument

	    ].

	    "/

	    "/ fetch sourceString of the method

	    "/

	    sourceCode := changedObject sourceCodeAt:selector.

	    sourceCode isNil ifTrue:[

		"method has been deleted"

"/                Transcript showCr: 'method has been deleted'.

	    ] ifFalse:[

		newMethod := changedObject 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 ...

		"/

		(changedObject isMeta not

		or:[newMethod category ~= 'documentation']) ifTrue:[

		    sourceCode := self addHistoryTo:sourceCode forceModification:(oldMethod notNil) forceCreation:(oldMethod isNil).

		    newMethod source: sourceCode.

"/                Transcript showCr: 'history updated / added'.

		]

	    ].

	    ^self

	]. 

	something == #comment ifTrue:[

	    "in someArgument steht jetzt der alte kommentar"

	    ^ self.