'From Smalltalk/X, Version:2.10.7 on 23-aug-1995 at 10:30:30 pm'                !

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

HistoryManager comment:'''Historymanagement for Smalltalk MultiUser Environment''
'!

!HistoryManager class methodsFor:'documentation'!

version
"
$Header: /cvs/stx/stx/libbasic3/HistoryManager.st,v 1.3 1995-08-27 16:25:33 claus Exp $
"
!

documentation
"
    This class is part of the 
	       -----------------------
		HistoryManagerProject.
	       -----------------------
    It is used to create a multi user Smalltalk developers Environemt.

    All Methods and Classes in the system get a HistroyLine which contains a timestamp
    and the name of the Editor. This is acually the UniX loginname.
    The Manager registers all Classes in the System to get notifications on change.

"
!

examples
"
    HistoryManager new
"
    "Modified: 11.08.1995 / 16:50:47 / robert"
! !

!HistoryManager class methodsFor:'initialization'!

initialize
    ""
    ObjectMemory addDependent: self.

    "Modified: 14.08.1995 / 9:49:56 / robert"
!

initMe
    "setup TheOneAndOnlyInstance (if not already present"
    ^self new.

    "Modified: 14.08.1995 / 9:52:40 / robert"
! !

!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 class variable"

    ^TheOneAndOnlyInstance
!

isActive 
    ^TheOneAndOnlyInstance notNil

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

!HistoryManager class methodsFor:'change and update'!

update: what
    (what == #restarted) ifTrue:[
	TheOneAndOnlyInstance notNil ifTrue:[
	    "
	     smalltalk is about to restart from an Image -
	    "
	    'HistoryManager initialize (via update)' printNL.
	    self initMe.
	]
    ].

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

!HistoryManager class methodsFor:'activation / deactivation'!

activate
    self new   "/ creating an instance activates me
!

deactivate
    Smalltalk allClassesDo:[:aClass |
	aClass removeDependent:TheOneAndOnlyInstance.
	aClass class removeDependent:TheOneAndOnlyInstance.
    ].
    TheOneAndOnlyInstance := nil.

"
    HistoryManager release
"
! !

!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 - set 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 - set an exclusionlist for some smalltalk classes which schold not be notified or historisized"

    | box  exclusionlist|

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

    Smalltalk allClasses do:[: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
    "private - add a historyLine at end to the sourceCode;
     check for multiple lines of the same user and merge into one."

    | histLines pos hm wStream sourceCode historyMode  previousHistories |

    previousHistories := self getAllHistoriesFrom:someString.
    "Check whether there is a Manager"    
"/    hm := Smalltalk at: #HistoryManager ifAbsent: [ Transcript show: 'no HistoryManager present'.^someString].

"/    historyMode := hm instance historyMode.     "this method (addHistroy is called only by the historyManager)"
"/
"/    historyMode = false ifTrue: [
"/        "do nothing with the Code i.e. for filein"
"/        ^someString
"/    ].    


    "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: (HistoryLine new).

    "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.08.1995 / 16:51:50 / robert"
!

getAllHistoriesFrom:someString
    "returns anArray of HistoryLines"

    |position aReadWriteStream firstFound nextFound  aHistoryString rcOC |

    "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.
	    "
	    (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.93 / 18:32:30 / M.Noell"
    "Modified: 09.08.95 / 22:45:30 / R.Sailer"
!

update: something with: someArgument from: changedObject

    "public - sent by an Event (smoething contains aSymbol or nil)"

    | sourceCode aMethod fileInOrRecompiling |

"/    changedObject == self ifTrue:[  "for development only"
"/        self halt.
"/        ^self.
"/    ].
    fileInOrRecompiling := Class updatingChanges.

    changedObject isMeta ifTrue:[
"/        Transcript showCr: 'metaClass = ',  changedObject printString.
    ].

    (changedObject == Smalltalk) & (something == #newClass) ifTrue:[
	someArgument addDependent: self.
	someArgument class  addDependent: self.   "for class methods"
    ].

    fileInOrRecompiling ifFalse:[ 
"/        Transcript showCr: '* noChange in history'. 
	^self 
    ].

    "
    Class Variables
    "
    (something == #definition) ifTrue:[
	"hier die gesamt behandlung fuer Klassen"        
    ].

    "this is a sub item of #definition"    
    (something == #classVariables) ifTrue:[
	"
	Transcript showCr: 'classVariables changed'.
	"
" das geht noch nicht, weil in someArgument nicht die Klasse steh die das betrifft"
	sourceCode := changedObject sourceCodeAt: #history.
	sourceCode isNil ifTrue:[
	    "method has not been created"
"/            Transcript showCr: 'method class-history has not been created'.
	] ifFalse:[
	    aMethod := changedObject compiledMethodAt: #history.
	    sourceCode := self addHistoryTo:sourceCode.
	    aMethod source: sourceCode.
"/            Transcript showCr: 'history updated / added'.
	    ^self
	].
    ].    

    "
    New Class creation
    "

    ((changedObject == Smalltalk)and:[ (something == #newClass)]) ifTrue:[
	" self in die Dependents eintragen damit die notification bei den Methoden kommt."
	someArgument addDependent: self.
	someArgument history: (self addHistoryTo:String new).  "append historyString for new class"
    ].

    "
    Instance Handling
    "

    changedObject isBehavior ifTrue:[
	something = #methodDictionary ifTrue:[
	    "SourceString der Methode holen"
	    sourceCode := changedObject sourceCodeAt: someArgument.
	    sourceCode isNil ifTrue:[
		"method has been deleted"
"/                Transcript showCr: 'method has been deleted'.
	    ] ifFalse:[
		aMethod := changedObject compiledMethodAt: someArgument.
		sourceCode := self addHistoryTo:sourceCode.
		aMethod source: sourceCode.
"/                Transcript showCr: 'history updated / added'.
	    ].
	    ^self
	]. 

	something == #comment ifTrue:[
	    "in someArgument steht jetzt der alte kommentar"
	    ^self.
	] ifFalse:[
	    "it is a class definition"
"/            Transcript show: 'Class definition: ', changedObject printString;cr.
	    sourceCode := changedObject sourceCodeAt: #history.
	    sourceCode isNil ifTrue:[
		"method has not been created"
"/                Transcript showCr: 'method class-history has not been created'.
	    ] ifFalse:[
		aMethod := changedObject compiledMethodAt: #history.

		sourceCode := self addHistoryTo:sourceCode.
		aMethod source: sourceCode.

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

    ^self

    "Modified: 27.8.1995 / 02:14:43 / claus"
! !

HistoryManager initialize!