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

StandardSystemView subclass:#ChangesBrowser
       instanceVariableNames:'changeListView codeView changeFileName 
                              changeChunks changePositions
                              changeClassNames
                              anyChanges changeNrShown changeNrProcessed
                              closeBox'
       classVariableNames:''
       poolDictionaries:''
       category:'Interface-Browsers'
!

ChangesBrowser comment:'

COPYRIGHT (c) 1990 by Claus Gittinger
            All Rights Reserved

this class implements a changes browser.

$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.6 1994-01-08 17:22:50 claus Exp $
written jan 90 by claus
'!

!ChangesBrowser class methodsFor:'behavior'!

autoSelectNext
    "returning true here, makes a Delete operation automatically
     select the next change"

    ^ true
! !

!ChangesBrowser class methodsFor:'instance creation'!

new
    "create a new changes browser"

    ^ super label:'Changes Browser'
             icon:(Form fromFile:'CBrowser.xbm' resolution:100)
!

startOn:aFileName
    "create c changes browser on a change file"

    ^ ((self new label:'Changes Browser:', aFileName) changeFileName:aFileName) open
! !

!ChangesBrowser methodsFor:'initialize / release'!

initialize
    |frame v|

    super initialize.

    changeFileName := 'changes'.

    frame := VariableVerticalPanel origin:(0.0 @ 0.0)
                                   corner:(1.0 @ 1.0)
                              borderWidth:0
                                       in:self.

    v := ScrollableView for:SelectionInListView in:frame.
    v origin:(0.0 @ 0.0) corner:(1.0 @ 0.3).
    changeListView := v scrolledView.

    v := ScrollableView for:CodeView in:frame.
    v origin:(0.0 @ 0.3) corner:(1.0 @ 1.0).
    codeView := v scrolledView.

    anyChanges := false.
!

initializeMiddleButtonMenu
    |labels|

    labels := resources array:#(
                               'apply change'
                               'apply changes to end'
                               'apply all changes'
                               '-'
                               'delete'
                               'delete to end'
                               'delete changes for this class to end'
                               'delete all changes for this class'
                               '-'
                               'update'
                               'compress'
                               'compare with current version'
                               '-'
                               'make change a patch'
                               'update sourcefile from change'
                               '-'
                               'writeback changeFile').

    changeListView
        middleButtonMenu:(PopUpMenu 
                            labels:labels
                         selectors:#(
                                     doApply
                                     doApplyRest
                                     doApplyAll
                                     nil
                                     doDelete
                                     doDeleteRest
                                     doDeleteClassRest
                                     doDeleteClassAll
                                     nil
                                     doUpdate
                                     doCompress
                                     doCompare
                                     nil
                                     doMakePatch
                                     doMakePermanent
                                     nil
                                     doWriteBack)
                          receiver:self
                               for:changeListView)
!

realize
    super realize.
    self readChangesFile.
    changeListView contents:changeChunks.
    changeListView action:[:lineNr | self changeSelection:lineNr].
    self disableMenuEntries.
!

destroy
    closeBox notNil ifTrue:[closeBox destroy. closeBox := nil].
    super destroy
! !

!ChangesBrowser methodsFor:'private'!

enableMenuEntries
    "enable all entries refering to a class"

    changeListView middleButtonMenu enable:#doApply.
    changeListView middleButtonMenu enable:#doApplyRest.
    changeListView middleButtonMenu enable:#doDelete.
    changeListView middleButtonMenu enable:#doDeleteRest.
    changeListView middleButtonMenu enable:#doDeleteClassRest.
    changeListView middleButtonMenu enable:#doDeleteClassAll.
    changeListView middleButtonMenu enable:#doCompare.
    changeListView middleButtonMenu enable:#doMakePatch.
    changeListView middleButtonMenu enable:#doMakePermanent.
!

disableMenuEntries
    "enable all entries refering to a class"

    changeListView middleButtonMenu disable:#doApply.
    changeListView middleButtonMenu disable:#doApplyRest.
    changeListView middleButtonMenu disable:#doDelete.
    changeListView middleButtonMenu disable:#doDeleteRest.
    changeListView middleButtonMenu disable:#doDeleteClassRest.
    changeListView middleButtonMenu disable:#doDeleteClassAll.
    changeListView middleButtonMenu disable:#doCompare.
    changeListView middleButtonMenu disable:#doMakePatch.
    changeListView middleButtonMenu disable:#doMakePermanent.
!

unselect
    "common unselect"

    changeListView deselect.
    self disableMenuEntries
!

queryCloseText
    "made this a method for easy redefinition in subclasses"

    ^ 'Quit without updating changeFile ?'
!

changeFileName:aFileName
    changeFileName := aFileName
!

withCursor:aCursor do:aBlock
    "evaluate aBlock while showing another cursor"

    |oldListCursor oldCodeViewCursor|

    oldListCursor := changeListView cursor.
    oldCodeViewCursor := codeView cursor.

    changeListView cursor:aCursor.
    codeView cursor:aCursor.

    aBlock valueNowOrOnUnwindDo:[
        changeListView cursor:oldListCursor.
        codeView cursor:oldCodeViewCursor
    ]
!

classNameOfChange:changeNr
    "return the classname of a change (for xxx class - changes xxx is returned)
     - since parsing ascii methods is slow, keep result cached in 
       changeClassNames for the next query"

    |chunk aParseTree recTree sel name arg1Tree|

    changeNr notNil ifTrue:[
        name := changeClassNames at:changeNr.
        name notNil ifTrue:[^ name].

        chunk := changeChunks at:changeNr.
        chunk notNil ifTrue:[
            aParseTree := Parser parseExpression:chunk.
            (aParseTree isKindOf:MessageNode) ifTrue:[
                sel := aParseTree selector.
                "a change for a method or a comment-change"
                (#(methodsFor: removeSelector: comment:) includes:sel) ifTrue:[
                    recTree := aParseTree receiver.
                    (recTree isKindOf:UnaryNode) ifTrue:[
                        (recTree selector ~~ #class) ifTrue:[^ nil].
                        "id class methodsFor:..."
                        recTree := recTree receiver
                    ].
                    (recTree isKindOf:PrimaryNode) ifTrue:[
                        name := recTree name.
                        changeClassNames at:changeNr put:name.
                        ^ name
                    ]
                ].
                "a change in a class-description"
                ('subclass:*' match:sel) ifTrue:[
                    arg1Tree := aParseTree arg1.
                    (arg1Tree isKindOf:ConstantNode) ifTrue:[
                        name := arg1Tree value asString.
                        changeClassNames at:changeNr put:name.
                        ^ name
                    ]
                ]
            ]
        ]
    ].
    ^ nil
!

streamForChange:changeNr
    "answer a stream for change"
 
    |aStream|

    aStream := FileStream readonlyFileNamed:changeFileName.
    aStream isNil ifTrue:[^ nil].
    aStream position:(changePositions at:changeNr).
    ^ aStream
!

clearCodeView
    self unselect "changeListView deselect".
    codeView contents:nil.
    changeNrShown := nil
!

autoSelect:changeNr
    self class autoSelectNext ifTrue:[
        (changeNr <= changeChunks size) ifTrue:[
            changeListView selection:changeNr.
            self changeSelection:changeNr.
            ^ self
        ]
    ].
    self clearCodeView
!

writeBackChanges
    "write back the changes file"

    |inStream outStream chunk sawExcla excla done dir|

    outStream := FileStream newFileNamed:'n_changes'.
    outStream isNil ifTrue:[
        self warn:'cannot create temporary file'.
        ^ self
    ].
   
    inStream := FileStream readonlyFileNamed:changeFileName.
    inStream isNil ifTrue:[^ nil].

    self withCursor:(Cursor write) do:[
        excla := inStream class chunkSeparator.
        1 to:(changeChunks size) do:[:index |
            inStream position:(changePositions at:index).
            sawExcla := inStream peekFor:excla.
            chunk := inStream nextChunk.

            sawExcla ifTrue:[
                outStream nextPut:excla.
                outStream nextChunkPut:chunk.
                outStream cr.
                "a method-definition chunk - skip followups"
                done := false.
                [done] whileFalse:[
                    chunk := inStream nextChunk.
                    chunk isNil ifTrue:[
                        done := true
                    ] ifFalse:[
                        outStream nextChunkPut:chunk.
                        outStream cr.
                        done := chunk isEmpty
                    ]
                ].
                0 "compiler kludge"
            ] ifFalse:[
                outStream nextChunkPut:chunk.
                outStream cr
            ]
        ].
        outStream close.
        inStream close.
        dir := FileDirectory currentDirectory.
        dir removeFile:changeFileName.
        dir renameFile:'n_changes' newName:changeFileName.
        anyChanges := false
    ]
!

readChangesFile
    "read the changes file, create a list of header-lines and 
     a list of chunk-poritions"

    |aStream index text done sawExcla chunkPos excla|

    aStream := FileStream readonlyFileNamed:changeFileName.
    aStream isNil ifTrue:[^ nil].

    self withCursor:(Cursor read) do:[
        changeChunks := OrderedCollection new.
        changePositions := OrderedCollection new.
        excla := aStream class chunkSeparator.

        [aStream atEnd] whileFalse:[
            aStream skipSeparators.
            chunkPos := aStream position.
            sawExcla := aStream peekFor:excla.
            text := aStream nextChunk.
            text notNil ifTrue:[
                changePositions add:chunkPos.

                "only first line is saved in changeChunks ..."
                index := text indexOf:(Character cr).
                (index ~~ 0) ifTrue:[
                    text := text copyFrom:1 to:(index - 1).

                    "take care for comment changes - must still be a
                     valid expression for classNameOfChange: to work"

                    (text endsWith:'comment:''') ifTrue:[
                        text := text , '...'''
                    ]

                ].
                changeChunks add:text.
                sawExcla ifTrue:[
                    "a method-definition chunk - skip followups"
                    done := false.
                    [done] whileFalse:[
                        text := aStream nextChunk.
                        text isNil ifTrue:[
                            done := true
                        ] ifFalse:[
                            done := text isEmpty
                        ]
                    ]
                ]
            ]
        ].
        changeClassNames := VariableArray new:(changeChunks size).
        aStream close.
        anyChanges := false
    ]
!

silentDeleteChange:changeNr
    "delete a change do not update changeListView"

    anyChanges := true.
    changeChunks removeIndex:changeNr.
    changePositions removeIndex:changeNr.
    changeClassNames removeIndex:changeNr
!


deleteChange:changeNr
    "delete a change"

    changeListView deselect.
    self silentDeleteChange:changeNr.
    changeListView setContents:changeChunks
!

deleteChangesFrom:start to:stop
    "delete a range of changes"

    changeListView deselect.
    stop to:start by:-1 do:[:changeNr |
        self silentDeleteChange:changeNr
    ].
    changeListView setContents:changeChunks
!

deleteChangesFor:aClassName from:start to:stop
    "delete changes for a given class in a range"

    |thisClassName index|

    index := stop.
    [index >= start] whileTrue:[
        thisClassName := self classNameOfChange:index.
        thisClassName = aClassName ifTrue:[
            self silentDeleteChange:index
        ].
        index := index - 1
    ]
!

applyChange:changeNr
    "filein a change"

    |aStream chunk sawExcla upd|

    aStream := self streamForChange:changeNr.
    aStream isNil ifTrue:[^ self].
    sawExcla := aStream peekFor:(aStream class chunkSeparator).
    chunk := aStream nextChunk.
    upd := Class updateChanges:false.
    codeView abortAction:[Class updateChanges:upd. 
                          codeView abortAction:nil. 
                          aStream close. 
                          ^self]. 
    changeNrProcessed := changeNr.
    [
        sawExcla ifFalse:[
            Compiler evaluate:chunk notifying:self
        ] ifTrue:[
            (Compiler evaluate:chunk notifying:self) fileInFrom:aStream
                                                      notifying:self
        ].
        changeNrProcessed := nil.
        codeView abortAction:nil
    ] valueNowOrOnUnwindDo:[Class updateChanges:upd].
    aStream close
!

compareChange:changeNr
    "compare a change with current version"

    |aStream chunk sawExcla parseTree thisClass cat oldSource newSource
     parser sel oldMethod|

    aStream := self streamForChange:changeNr.
    aStream isNil ifTrue:[^ self].
    sawExcla := aStream peekFor:(aStream class chunkSeparator).
    chunk := aStream nextChunk.
    sawExcla ifFalse:[
        Transcript showCr:'not comparable ...'
    ] ifTrue:[
        parseTree := Parser parseExpression:chunk.
        (parseTree isKindOf:MessageNode) ifTrue:[
            (parseTree selector == #methodsFor:) ifTrue:[
                thisClass := (parseTree receiver evaluate).
                (thisClass isBehavior "isKindOf:Class") ifTrue:[
                    cat := parseTree arg1 evaluate.
                    newSource := aStream nextChunk.
                    parser := Parser parseMethod:newSource in:thisClass.
                    parser notNil ifTrue:[
                        sel := parser selector.
                        oldMethod := thisClass compiledMethodAt:sel.
                        oldMethod notNil ifTrue:[
                            (oldMethod category = cat) ifFalse:[
                                Transcript showCr:'category changed.'
                            ].
                            oldSource := oldMethod source.
                            (oldSource = newSource) ifTrue:[
                                Transcript showCr:'same source'
                            ] ifFalse:[
                                Transcript showCr:'source changed.'
                            ]
                        ] ifFalse:[
                            Transcript showCr:'method does not exist.'
                        ]
                    ] ifFalse:[
                        Transcript showCr:'change unparsable.'
                    ]
                ] ifFalse:[
                    Transcript showCr:'class does not exist.'
                ]
            ] ifFalse:[
                Transcript showCr:'not comparable.'
            ]
        ] ifFalse:[
            Transcript showCr:'not comparable.'
        ]
    ].
    aStream close
!

makeChangeAPatch:changeNr
    "copy change to patchfile"

    |aStream outStream chunk sawExcla|

    outStream := FileStream oldFileNamed:'patches'.
    outStream isNil ifTrue:[
        outStream isNil ifTrue:[
            outStream := FileStream newFileNamed:'patches'.
            outStream isNil ifTrue:[
                self error:'cannot update patches file'.
                ^ self
            ]
        ]
    ].
    outStream setToEnd.
    aStream := self streamForChange:changeNr.
    aStream isNil ifTrue:[^ self].
    sawExcla := aStream peekFor:(aStream class chunkSeparator).
    sawExcla ifTrue:[
        outStream nextPut:$!!
    ].
    chunk := aStream nextChunk.
    outStream nextChunkPut:chunk.
    outStream cr.
    sawExcla ifTrue:[
        chunk := aStream nextChunk.
        outStream nextChunkPut:chunk.
        outStream space
    ].
    sawExcla ifTrue:[
        outStream nextPut:$!!
    ].
    outStream cr.
    aStream close.
    outStream close
!

makeChangePermanent:changeNr
    "rewrite the source where change changeNr lies"

    self notify:'this is not yet implemented'
! !

!ChangesBrowser methodsFor:'error handling'!

correctableError:aString position:relPos to:relEndPos
    "compiler notifys us of an error - this should really not happen since
     changes ought to be correct (did someone edit the changes file ??).
     Show the bad change in the codeView and let codeView hilight the error;
     no corrections allowed here therefore return false"

    (changeNrProcessed ~~ changeNrShown) ifTrue:[
        self changeSelection:changeNrProcessed
    ].
    codeView error:aString position:relPos to:relEndPos.
    ^ false
!

error:aString position:relPos to:relEndPos
    "compiler notifys us of an error - this should really not happen since
     changes ought to be correct (did someone edit the changes file ??).
     Show the bad change in the codeView and let codeView hilight the error"

    (changeNrProcessed ~~ changeNrShown) ifTrue:[
        self changeSelection:changeNrProcessed
    ].
    ^ codeView error:aString position:relPos to:relEndPos
!

warning:aString position:relPos to:relEndPos
    "compiler notifys us of a warning - ignore it"

    ^ self
! !

!ChangesBrowser methodsFor:'user interaction'!

noChangesAllowed
    "show a warning that changes cannot be changed"

    self warn:(resources at:'changes are not allowed to be changed')
!

changeSelection:lineNr
    "show a change in the codeView"

    |aStream sawExcla chunk|

    aStream := self streamForChange:lineNr.
    aStream isNil ifTrue:[^ self].
    sawExcla := aStream peekFor:(aStream class chunkSeparator).
    chunk := aStream nextChunk.
    sawExcla ifTrue:[
        chunk := aStream nextChunk
    ].
    aStream close.
    codeView contents:chunk.
    codeView acceptAction:[:theCode | self doApply "noChangesAllowed"].
    changeNrShown := lineNr.
    self enableMenuEntries
!

doMakePermanent
    "user wants a change to be made permanent
     - rewrite the source file where this change has to go"

    |changeNr yesNoBox|

    yesNoBox isNil ifTrue:[
        yesNoBox := YesNoBox new
    ].
    yesNoBox title:(resources at:'Warning: this operation cannot be undone').
    yesNoBox okText:(resources at:'apply').
    yesNoBox noText:(resources at:'abort').
    yesNoBox okAction:[
                  changeNr := changeListView selection.
                  changeNr notNil ifTrue:[
                      self makeChangePermanent:changeNr.
                      self autoSelect:(changeNr + 1)
                  ]
    ].
    yesNoBox showAtPointer
!

doMakePatch
    "user wants a change to be made a patch
     - copy it over to the patches file"

    |changeNr|

    changeNr := changeListView selection.
    changeNr notNil ifTrue:[
        self makeChangeAPatch:changeNr.
        self autoSelect:(changeNr + 1)
    ]
!

doApply
    "user wants a change to be applied"

    |changeNr|

    changeNr := changeListView selection.
    changeNr notNil ifTrue:[
        self withCursor:(Cursor execute) do:[
            self applyChange:changeNr.
            self autoSelect:(changeNr + 1)
        ]
    ]
!

doApplyAll
    "user wants all changes to be applied"

    self withCursor:(Cursor execute) do:[
        self clearCodeView.
        1 to:(changePositions size) do:[:changeNr |
            changeListView selection:changeNr.
            self applyChange:changeNr
        ]
    ]
!

doApplyRest
    "user wants all changes from changeNr to be applied"

    |changeNr|

    changeNr := changeListView selection.
    changeNr notNil ifTrue:[
        self withCursor:(Cursor execute) do:[
            self clearCodeView.
            changeNr to:(changePositions size) do:[:changeNr |
                changeListView selection:changeNr.
                self applyChange:changeNr
            ]
        ]
    ]
!

doDelete
    "delete currently selected change"

    |changeNr|

    changeNr := changeListView selection.
    changeNr notNil ifTrue:[
        self deleteChange:changeNr.
        self autoSelect:changeNr
    ]
!

doDeleteClassRest
    "delete rest of changes with same class as currently selected change"

    |changeNr classNameToDelete|

    changeNr := changeListView selection.
    changeNr notNil ifTrue:[
        self withCursor:(Cursor execute) do:[
            classNameToDelete := self classNameOfChange:changeNr.
            classNameToDelete notNil ifTrue:[
                changeListView selection:nil.
                self deleteChangesFor:classNameToDelete 
                                 from:changeNr
                                   to:(changeChunks size).
                changeListView setContents:changeChunks.
                self autoSelect:changeNr
            ]
        ]
    ]
!

doDeleteRest
    "delete all changes from current to the end"

    |changeNr|

    changeNr := changeListView selection.
    changeNr notNil ifTrue:[
        self deleteChangesFrom:changeNr to:(changeChunks size).
        self clearCodeView
    ]
!

doDeleteClassAll
    "delete all changes with same class as currently selected change"

    |changeNr classNameToDelete|

    changeNr := changeListView selection.
    changeNr notNil ifTrue:[
        self withCursor:(Cursor execute) do:[
            classNameToDelete := self classNameOfChange:changeNr.
            classNameToDelete notNil ifTrue:[
                changeListView selection:nil.
                self deleteChangesFor:classNameToDelete
                                 from:1
                                   to:(changeChunks size).
                changeListView contents:changeChunks.
                self autoSelect:changeNr
            ]
        ]
    ]
!

doWriteBack
    "write back the list onto the changes file"

    anyChanges ifTrue:[
        self writeBackChanges.
        self doUpdate
    ]
!

saveAndTerminate
    "update the changes file and quit"

    self doWriteBack.
    self destroy
!

terminate
    "window manager wants ChangeBrowser to vanish"

    anyChanges ifTrue:[
        closeBox isNil ifTrue:[closeBox := YesNoBox new].
        closeBox title:(resources at:(self queryCloseText)).
        closeBox yesAction:[self destroy] noAction:nil.
        closeBox showAtPointer
    ] ifFalse:[
        self destroy
    ]
!

doUpdate
    "reread the changes-file"

    self readChangesFile.
    changeListView setContents:changeChunks
!

doCompare
    "compare change with current system version
     - give a note in transcript"

    |changeNr|

    changeNr := changeListView selection.
    changeNr notNil ifTrue:[
        self compareChange:changeNr
    ]
!

doCompress
    "compress the change-set; this replaces multiple method-changes by the last 
     (i.e. the most recent) change"

    |classes types selectors thisClass thisSelector
     aStream chunk changeNr sawExcla aParseTree codeChunk codeParser
     searchIndex anyMore deleteSet index parseTreeChunk numChanges
     excla|

    aStream := FileStream readonlyFileNamed:changeFileName.
    aStream isNil ifTrue:[^ self].

    self withCursor:(Cursor execute) do:[
        numChanges := changePositions size.
        classes := Array new:numChanges.
        selectors := Array new:numChanges.
        types := Array new:numChanges.

        "starting at the end, get the change class and change selector;
         collect all in classes / selectors"

        changeNr := numChanges.
        excla := aStream class chunkSeparator.

        [changeNr >= 1] whileTrue:[
            aStream position:(changePositions at:changeNr).
            sawExcla := aStream peekFor:excla.
            chunk := aStream nextChunk.
            sawExcla ifTrue:[
                "optimize a bit if multiple methods for same category arrive"
                (chunk = parseTreeChunk) ifFalse:[
                    aParseTree := Parser parseExpression:chunk.
                    parseTreeChunk := chunk
                ].
                (aParseTree isKindOf:MessageNode) ifTrue:[
                    (aParseTree selector == #methodsFor:) ifTrue:[
                        thisClass := (aParseTree receiver evaluate).
                        codeChunk := aStream nextChunk.
                        codeParser := Parser parseMethodSpecification:codeChunk
                                                                   in:thisClass.
                        codeParser notNil ifTrue:[
                            selectors at:changeNr put:(codeParser selector).
                            classes at:changeNr put:thisClass.
                            types at:changeNr put:#methodsFor
                        ]
                    ]
                ]
            ] ifFalse:[
                aParseTree := Parser parseExpression:chunk.
                parseTreeChunk := chunk.
                (aParseTree isKindOf:MessageNode) ifTrue:[
                    (aParseTree selector == #removeSelector:) ifTrue:[
                        selectors at:changeNr put:(aParseTree arg1 value ).
                        classes at:changeNr put:(aParseTree receiver evaluate).
                        types at:changeNr put:#removeSelector
                    ]
                ]
            ].
            changeNr := changeNr - 1
        ].
        aStream close.

        "for all changes, look for another class/selector occurence and
         add change number to delete set if found"

        deleteSet := OrderedCollection new.
        changeNr := 1.
        [changeNr < changePositions size] whileTrue:[
            thisClass := classes at:changeNr.
            thisSelector := selectors at:changeNr.
            searchIndex := changeNr.
            anyMore := true.
            [anyMore] whileTrue:[
                searchIndex := classes indexOf:thisClass
                                    startingAt:(searchIndex + 1).
                (searchIndex ~~ 0) ifTrue:[
                    ((selectors at:searchIndex) == thisSelector) ifTrue:[
                        thisClass notNil ifTrue:[
                            deleteSet add:changeNr.
                            anyMore := false
                        ]
                    ]
                ] ifFalse:[
                    anyMore := false      
                ]
            ].
            changeNr := changeNr + 1
        ].

        "finally delete what has been found"

        (deleteSet size > 0) ifTrue:[
            changeListView selection:nil.
            index := deleteSet size.
            [index > 0] whileTrue:[
                self silentDeleteChange:(deleteSet at:index).
                index := index - 1
            ].
            changeListView setContents:changeChunks.
            changeListView firstLineShown > changeChunks size ifTrue:[
                changeListView makeLineVisible:changeChunks size
            ].
            self clearCodeView
        ]
    ]
! !