ChangesBrowser.st
changeset 4487 7f3d0a3ba32a
parent 4484 68db879de664
child 4488 17394d51eabc
--- a/ChangesBrowser.st	Sun Jan 26 21:24:52 2003 +0100
+++ b/ChangesBrowser.st	Mon Jan 27 11:46:27 2003 +0100
@@ -13,16 +13,17 @@
 "{ Package: 'stx:libtool' }"
 
 StandardSystemView subclass:#ChangesBrowser
-	instanceVariableNames:'changeListView codeView changeFileName changeChunks
+	instanceVariableNames:'changeListView codeView diffView changeFileName changeChunks
 		changePositions changeClassNames changeSelectors
 		changeHeaderLines changeIsFollowupMethodChange anyChanges
 		changeNrShown changeNrProcessed skipSignal autoCompare
 		changeFileSize changeFileTimestamp checkBlock changeTimeStamps
 		tabSpec autoUpdate editingClassSource lastSearchType
 		lastSearchString applyInOriginalNameSpace lastSaveFileName
-		readOnly enforcedPackage enforcedNameSpace updateChangeSet'
+		readOnly enforcedPackage enforcedNameSpace updateChangeSet
+		showingDiffs diffViewBox'
 	classVariableNames:'CompressSnapshotInfo NoColoring ShowWarningDialogs DefaultIcon
-		DefaultAutoCompare'
+		DefaultAutoCompare DefaultShowingDiffs'
 	poolDictionaries:''
 	category:'Interface-Browsers'
 !
@@ -573,6 +574,11 @@
                   #indication: #autoCompare
                 )
                #(#MenuItem
+                  #label: 'Show Diffs'
+                  #translateLabel: true
+                  #indication: #showingDiffs
+                )
+               #(#MenuItem
                   #label: 'Auto Update'
                   #translateLabel: true
                   #indication: #autoUpdate
@@ -763,6 +769,23 @@
     readOnly := aBoolean
 !
 
+showingDiffs
+    showingDiffs isNil ifTrue:[
+        showingDiffs := (DefaultShowingDiffs ? true) asValue.
+        showingDiffs 
+            onChangeEvaluate:[
+                showingDiffs value ifTrue:[
+                    self updateDiffView.
+                    self makeDiffViewVisible
+                ] ifFalse:[
+                    self makeDiffViewInvisible
+                ].
+                DefaultShowingDiffs := showingDiffs value.
+            ]
+    ].
+    ^ showingDiffs
+!
+
 theSingleSelection
     |sel|
 
@@ -1168,7 +1191,7 @@
 
 initialize
     |panel v upperFrame buttonPanel menuPanel mH
-     checkBox protectExistingMethods oldStyle|
+     checkBox oldStyle codeViewBox lbl|
 
     "/ oldStyle := true.
     oldStyle := false.
@@ -1254,11 +1277,49 @@
 "/    protectExistingMethods model:protectExistingMethods.
 "/    buttonPanel addSubView:protectExistingMethods.
 
-    v := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:panel.
-    v origin:(0.0 @ 0.3) corner:(1.0 @ 1.0).
+    codeViewBox := View in:panel.
+    codeViewBox origin:(0.0 @ 0.3) corner:(1.0 @ 1.0).
+
+    v := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:codeViewBox.
+    v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
     codeView := v scrolledView.
     codeView readOnly:true.
 
+    diffViewBox := View in:codeViewBox.
+    diffViewBox origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+
+    lbl := Label label:'Current' in:diffViewBox.
+    lbl layout:(LayoutFrame
+                        leftFraction:0.0 offset:0
+                        rightFraction:0.5 offset:0
+                        topFraction:0.0 offset:0
+                        bottomFraction:0.0 offset:20).
+    lbl := Label label:'Change' in:diffViewBox.
+    lbl layout:(LayoutFrame
+                        leftFraction:0.5 offset:0
+                        rightFraction:1.0 offset:0
+                        topFraction:0.0 offset:0
+                        bottomFraction:0.0 offset:20).
+
+"/    diffView := DiffTextView in:diffViewBox.
+"/    diffView layout:(LayoutFrame
+"/                        leftFraction:0.0 offset:0
+"/                        rightFraction:1.0 offset:0
+"/                        topFraction:0.0 offset:20
+"/                        bottomFraction:1.0 offset:0).
+
+    v := HVScrollableView for:DiffTextView miniScrollerH:true miniScrollerV:false in:diffViewBox.
+    v layout:(LayoutFrame
+                        leftFraction:0.0 offset:0
+                        rightFraction:1.0 offset:0
+                        topFraction:0.0 offset:20
+                        bottomFraction:1.0 offset:0).
+    diffView := v scrolledView.
+
+    self showingDiffs value ifFalse:[
+        self makeDiffViewInvisible
+    ].
+
     anyChanges := false.
     ObjectMemory addDependent:self.   "to get shutdown-update"
 
@@ -1497,6 +1558,14 @@
     ^ false
 !
 
+makeDiffViewInvisible
+    diffViewBox lower
+!
+
+makeDiffViewVisible
+    diffViewBox raise
+!
+
 nameSpaceForApply
     applyInOriginalNameSpace value ifFalse:[
         ^ enforcedNameSpace ? Class nameSpaceQuerySignal query.    
@@ -3695,6 +3764,249 @@
     "Created: / 7.3.1997 / 16:28:32 / cg"
     "Modified: / 7.2.1998 / 19:59:11 / cg"
     "Modified: / 26.2.1998 / 18:20:48 / stefan"
+!
+
+updateDiffView
+    self withSelectedChangesDo:[:changeNr |
+        self updateDiffViewFor:changeNr.
+        ^ self.
+    ].
+
+    diffView text1:'' text2:''
+!
+
+updateDiffViewFor:changeNr
+    |aStream chunk sawExcla parseTree thisClass cat oldSource newSource
+     parser sel outcome showDiff selector isLoaded
+     method superClass thisClassSym varsHere varsInChange
+     ownerClass oldMethod|
+
+    aStream := self streamForChange:changeNr.
+    aStream isNil ifTrue:[^ self].
+
+    showDiff := false.
+
+    (self changeIsFollowupMethodChange:changeNr) ifFalse:[
+        sawExcla := aStream peekFor:(aStream class chunkSeparator).
+        chunk := aStream nextChunk.
+    ] ifTrue:[
+        chunk := (changeChunks at:changeNr).
+        sawExcla := true.
+    ].
+
+    sawExcla ifFalse:[
+        Class nameSpaceQuerySignal answer:(self nameSpaceForApply)
+        do:[
+            parseTree := Parser parseExpression:chunk.
+        ].
+        (parseTree notNil and:[parseTree ~~ #Error and:[ parseTree isMessage ]]) ifTrue:[
+            selector := parseTree selector.
+
+            selector == #'removeSelector:' ifTrue:[
+                thisClass := (parseTree receiver evaluate).
+                thisClass isBehavior ifTrue:[
+                    (self checkClassIsLoaded:thisClass) ifTrue:[
+                        selector := (parseTree arg1 evaluate).
+                        (thisClass includesSelector:selector) ifTrue:[
+                            oldSource := (thisClass compiledMethodAt:selector) source.
+                            newSource := nil.
+                        ]
+                    ] ifFalse:[
+                        oldSource := newSource := 'Cannot compare this change (compare requires class to be loaded).'.
+                    ]
+                ] ifFalse:[
+                    oldSource := newSource := 'Cannot compare this change (class not present)'.
+                ].
+            ].
+
+            selector == #'category:' ifTrue:[
+                parseTree receiver isMessage ifTrue:[
+                    parseTree receiver selector == #compiledMethodAt: ifTrue:[
+                        (method := parseTree receiver evaluate) isMethod ifTrue:[
+                            method category = parseTree arg1 evaluate ifFalse:[
+                                oldSource := chunk.
+                                newSource := '(' , method class name , ' compiledMethodAt: ' , method selector storeString , ') category: ' , method category storeString.
+                            ]
+                        ] ifFalse:[
+                            oldSource := newSource := 'There is no such method'.
+                        ]
+                    ]
+                ]
+            ].
+
+            selector == #'comment:' ifTrue:[
+                thisClass := (parseTree receiver evaluate).
+                thisClass isBehavior ifTrue:[
+                    (self checkClassIsLoaded:thisClass) ifTrue:[
+                        (thisClass comment = parseTree arg1 evaluate) ifTrue:[
+                            outcome := 'Change has no effect\\(same comment)'.
+                        ] ifFalse:[
+                            oldSource := chunk.
+                            newSource := thisClass name , ' comment: ' , thisClass comment storeString.
+                        ]
+                    ] ifFalse:[
+                        oldSource := newSource := 'Cannot compare this change (compare requires class to be loaded).'.
+                    ]
+                ] ifFalse:[
+                    oldSource := newSource := 'Cannot compare this change (class not present)'.
+                ].
+            ].
+
+            selector == #'instanceVariableNames:' ifTrue:[
+                parseTree receiver isMessage ifTrue:[
+                    parseTree receiver selector == #class ifTrue:[
+                        thisClass := (parseTree receiver evaluate).
+                        thisClass isBehavior ifTrue:[
+                            (self checkClassIsLoaded:thisClass) ifTrue:[
+                                varsHere := thisClass instanceVariableString asCollectionOfWords.
+                                varsInChange := (parseTree arguments at:1) evaluate asCollectionOfWords.
+                                varsHere = varsInChange ifTrue:[
+                                    oldSource := newSource := 'Change has no effect\\(same definition)'.
+                                ] ifFalse:[
+                                    oldSource := chunk.
+                                    newSource := thisClass definitionString.
+                                ].
+                            ] ifFalse:[
+                                oldSource := newSource := 'Cannot compare this change (compare requires class to be loaded).'.
+                            ].
+                        ] ifFalse:[
+                            oldSource := newSource := 'Cannot compare this change (class not present)'.
+                        ]
+                    ].
+                ]
+            ].
+
+            (Class definitionSelectors includes:selector)
+            "/ selector == #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:' 
+            ifTrue:[
+                superClass := (parseTree receiver evaluate).
+                superClass isBehavior ifFalse:[
+                    oldSource := newSource := 'Cannot compare this change\\(superclass not loaded).'.
+                ] ifTrue:[
+                    (self checkClassIsLoaded:superClass) ifTrue:[
+                        thisClassSym := (parseTree arguments at:1) evaluate.
+
+                        (selector endsWith:':privateIn:') ifTrue:[
+                            ownerClass := (parseTree arguments at:5) evaluate.
+                            thisClass := ownerClass privateClassesAt:thisClassSym.
+                        ] ifFalse:[
+                            thisClass := (self nameSpaceForApply) at:thisClassSym ifAbsent:nil.
+                        ].
+                        thisClass isNil ifTrue:[
+                            oldSource := newSource := 'Change defines the class: ' , thisClassSym allBold.
+                        ] ifFalse:[
+                            (isLoaded := self checkClassIsLoaded:thisClass) ifFalse:[
+                                oldSource := newSource := 'Cannot compare this change\\(compare requires class to be loaded).'.
+                            ] ifTrue:[
+                                oldSource := chunk.
+                                newSource := thisClass definitionString.
+                            ]
+                        ]
+                    ]
+                ]
+            ]
+        ]
+    ] ifTrue:[
+        Class nameSpaceQuerySignal answer:(self nameSpaceForApply)
+        do:[
+            parseTree := Parser parseExpression:chunk.
+        ].
+        (parseTree notNil 
+         and:[parseTree ~~ #Error
+         and:[parseTree isMessage]]) ifTrue:[
+            "/ Squeak support (#methodsFor:***)
+            (#(
+               #methodsFor: 
+               #privateMethodsFor:
+               #publicMethodsFor:
+               #ignoredMethodsFor:
+               #protectedMethodsFor:
+
+               #methodsFor:stamp:             "/ Squeak support
+               #methodsFor                    "/ Dolphin support
+               #methods                       "/ STV support
+              ) 
+            includes:parseTree selector) ifTrue:[
+                thisClass := (parseTree receiver evaluate).
+                thisClass isBehavior ifTrue:[
+                    (isLoaded := self checkClassIsLoaded:thisClass) ifFalse:[
+                        oldSource := newSource := 'Cannot compare this change\\(compare requires class to be loaded).'.
+                    ] ifTrue:[
+                        parseTree selector == #methodsFor ifTrue:[
+                            cat := 'Dolphin methods'.
+                        ] ifFalse:[
+                            parseTree selector == #methods ifTrue:[
+                                cat := 'STV methods'.
+                            ] ifFalse:[
+                                cat := parseTree arg1 evaluate.
+                            ].
+                        ].
+                        newSource := aStream nextChunk.
+
+                        Class nameSpaceQuerySignal answer:(self nameSpaceForApply)
+                        do:[
+                            parser := Parser parseMethod:newSource in:thisClass.
+                        ].
+                        (parser notNil and:[parser ~~ #Error]) ifTrue:[
+                            sel := parser selector.
+                            oldMethod := thisClass compiledMethodAt:sel.
+                            oldMethod notNil ifTrue:[
+                                (oldMethod category = cat) ifFalse:[
+                                    Transcript showCR:'category changed.'.
+                                ].
+                                oldSource := oldMethod source.
+                                (oldSource = newSource) ifFalse:[
+                                    oldSource isNil ifTrue:[
+                                        oldSource := newSource := 'No source for compare.'.
+                                    ] ifFalse:[
+                                        "/
+                                        "/ compare for tabulator <-> space changes
+                                        "/ before showing diff ...
+                                        "/
+                                        oldSource := oldSource asCollectionOfLines collect:[:s | s withTabsExpanded].
+                                        newSource := newSource asCollectionOfLines collect:[:s | s withTabsExpanded].
+                                        oldSource = newSource ifFalse:[
+                                            "/
+                                            "/ check if only historyLine diffs
+                                            "/
+                                            (HistoryManager notNil 
+                                            and:[HistoryManager isActive]) ifTrue:[
+                                                (HistoryManager withoutHistoryLines:newSource)
+                                                =
+                                                (HistoryManager withoutHistoryLines:oldSource)
+                                                ifTrue:[
+                                                    oldSource := (HistoryManager withoutHistoryLines:oldSource).
+                                                    newSource := (HistoryManager withoutHistoryLines:newSource).
+                                                ]
+                                            ].
+                                        ]
+                                    ]
+                                ]
+                            ] ifFalse:[
+                                isLoaded ifTrue:[
+                                    oldSource := newSource := 'Method does not exist.'.
+                                ]
+                            ]
+                        ] ifFalse:[
+                            oldSource := newSource := 'Change is unparsable (parse error).'.
+                        ].
+                    ].
+                ] ifFalse:[
+                    oldSource := newSource := 'Class does not exist.'.
+                ]
+            ] ifFalse:[
+                oldSource := newSource := 'Not comparable.'.
+            ]
+        ] ifFalse:[
+            oldSource := newSource := 'Not comparable.'.
+        ]
+    ].
+    aStream close.
+
+    diffView text1:(oldSource ? '') text2:(newSource ? '').
+
+    "Created: / 24.11.1995 / 14:30:46 / cg"
+    "Modified: / 13.2.2000 / 15:04:39 / cg"
 ! !
 
 !ChangesBrowser methodsFor:'termination'!
@@ -3864,6 +4176,10 @@
     ].
     changeNrShown := lineNr.
 
+    self showingDiffs value ifTrue:[
+        self updateDiffViewFor:changeNrShown.
+    ].
+
     "Modified: / 28.2.1999 / 15:26:46 / cg"
 !
 
@@ -5136,5 +5452,5 @@
 !ChangesBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.283 2003-01-26 14:11:16 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.284 2003-01-27 10:46:27 penk Exp $'
 ! !