ChangesBrowser.st
changeset 4487 7f3d0a3ba32a
parent 4484 68db879de664
child 4488 17394d51eabc
equal deleted inserted replaced
4486:8656068aaefb 4487:7f3d0a3ba32a
    11 "
    11 "
    12 
    12 
    13 "{ Package: 'stx:libtool' }"
    13 "{ Package: 'stx:libtool' }"
    14 
    14 
    15 StandardSystemView subclass:#ChangesBrowser
    15 StandardSystemView subclass:#ChangesBrowser
    16 	instanceVariableNames:'changeListView codeView changeFileName changeChunks
    16 	instanceVariableNames:'changeListView codeView diffView changeFileName changeChunks
    17 		changePositions changeClassNames changeSelectors
    17 		changePositions changeClassNames changeSelectors
    18 		changeHeaderLines changeIsFollowupMethodChange anyChanges
    18 		changeHeaderLines changeIsFollowupMethodChange anyChanges
    19 		changeNrShown changeNrProcessed skipSignal autoCompare
    19 		changeNrShown changeNrProcessed skipSignal autoCompare
    20 		changeFileSize changeFileTimestamp checkBlock changeTimeStamps
    20 		changeFileSize changeFileTimestamp checkBlock changeTimeStamps
    21 		tabSpec autoUpdate editingClassSource lastSearchType
    21 		tabSpec autoUpdate editingClassSource lastSearchType
    22 		lastSearchString applyInOriginalNameSpace lastSaveFileName
    22 		lastSearchString applyInOriginalNameSpace lastSaveFileName
    23 		readOnly enforcedPackage enforcedNameSpace updateChangeSet'
    23 		readOnly enforcedPackage enforcedNameSpace updateChangeSet
       
    24 		showingDiffs diffViewBox'
    24 	classVariableNames:'CompressSnapshotInfo NoColoring ShowWarningDialogs DefaultIcon
    25 	classVariableNames:'CompressSnapshotInfo NoColoring ShowWarningDialogs DefaultIcon
    25 		DefaultAutoCompare'
    26 		DefaultAutoCompare DefaultShowingDiffs'
    26 	poolDictionaries:''
    27 	poolDictionaries:''
    27 	category:'Interface-Browsers'
    28 	category:'Interface-Browsers'
    28 !
    29 !
    29 
    30 
    30 !ChangesBrowser class methodsFor:'documentation'!
    31 !ChangesBrowser class methodsFor:'documentation'!
   569               #(
   570               #(
   570                #(#MenuItem
   571                #(#MenuItem
   571                   #label: 'Auto Compare'
   572                   #label: 'Auto Compare'
   572                   #translateLabel: true
   573                   #translateLabel: true
   573                   #indication: #autoCompare
   574                   #indication: #autoCompare
       
   575                 )
       
   576                #(#MenuItem
       
   577                   #label: 'Show Diffs'
       
   578                   #translateLabel: true
       
   579                   #indication: #showingDiffs
   574                 )
   580                 )
   575                #(#MenuItem
   581                #(#MenuItem
   576                   #label: 'Auto Update'
   582                   #label: 'Auto Update'
   577                   #translateLabel: true
   583                   #translateLabel: true
   578                   #indication: #autoUpdate
   584                   #indication: #autoUpdate
   759     ^ (readOnly ~~ true)
   765     ^ (readOnly ~~ true)
   760 !
   766 !
   761 
   767 
   762 readOnly:aBoolean
   768 readOnly:aBoolean
   763     readOnly := aBoolean
   769     readOnly := aBoolean
       
   770 !
       
   771 
       
   772 showingDiffs
       
   773     showingDiffs isNil ifTrue:[
       
   774         showingDiffs := (DefaultShowingDiffs ? true) asValue.
       
   775         showingDiffs 
       
   776             onChangeEvaluate:[
       
   777                 showingDiffs value ifTrue:[
       
   778                     self updateDiffView.
       
   779                     self makeDiffViewVisible
       
   780                 ] ifFalse:[
       
   781                     self makeDiffViewInvisible
       
   782                 ].
       
   783                 DefaultShowingDiffs := showingDiffs value.
       
   784             ]
       
   785     ].
       
   786     ^ showingDiffs
   764 !
   787 !
   765 
   788 
   766 theSingleSelection
   789 theSingleSelection
   767     |sel|
   790     |sel|
   768 
   791 
  1166     ^ Array with:changeListView with:codeView
  1189     ^ Array with:changeListView with:codeView
  1167 !
  1190 !
  1168 
  1191 
  1169 initialize
  1192 initialize
  1170     |panel v upperFrame buttonPanel menuPanel mH
  1193     |panel v upperFrame buttonPanel menuPanel mH
  1171      checkBox protectExistingMethods oldStyle|
  1194      checkBox oldStyle codeViewBox lbl|
  1172 
  1195 
  1173     "/ oldStyle := true.
  1196     "/ oldStyle := true.
  1174     oldStyle := false.
  1197     oldStyle := false.
  1175 
  1198 
  1176     super initialize.
  1199     super initialize.
  1252 "/    protectExistingMethods := CheckBox new.
  1275 "/    protectExistingMethods := CheckBox new.
  1253 "/    protectExistingMethods label:(resources string:'Protect existing code' withCRs).
  1276 "/    protectExistingMethods label:(resources string:'Protect existing code' withCRs).
  1254 "/    protectExistingMethods model:protectExistingMethods.
  1277 "/    protectExistingMethods model:protectExistingMethods.
  1255 "/    buttonPanel addSubView:protectExistingMethods.
  1278 "/    buttonPanel addSubView:protectExistingMethods.
  1256 
  1279 
  1257     v := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:panel.
  1280     codeViewBox := View in:panel.
  1258     v origin:(0.0 @ 0.3) corner:(1.0 @ 1.0).
  1281     codeViewBox origin:(0.0 @ 0.3) corner:(1.0 @ 1.0).
       
  1282 
       
  1283     v := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:codeViewBox.
       
  1284     v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
  1259     codeView := v scrolledView.
  1285     codeView := v scrolledView.
  1260     codeView readOnly:true.
  1286     codeView readOnly:true.
       
  1287 
       
  1288     diffViewBox := View in:codeViewBox.
       
  1289     diffViewBox origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
       
  1290 
       
  1291     lbl := Label label:'Current' in:diffViewBox.
       
  1292     lbl layout:(LayoutFrame
       
  1293                         leftFraction:0.0 offset:0
       
  1294                         rightFraction:0.5 offset:0
       
  1295                         topFraction:0.0 offset:0
       
  1296                         bottomFraction:0.0 offset:20).
       
  1297     lbl := Label label:'Change' in:diffViewBox.
       
  1298     lbl layout:(LayoutFrame
       
  1299                         leftFraction:0.5 offset:0
       
  1300                         rightFraction:1.0 offset:0
       
  1301                         topFraction:0.0 offset:0
       
  1302                         bottomFraction:0.0 offset:20).
       
  1303 
       
  1304 "/    diffView := DiffTextView in:diffViewBox.
       
  1305 "/    diffView layout:(LayoutFrame
       
  1306 "/                        leftFraction:0.0 offset:0
       
  1307 "/                        rightFraction:1.0 offset:0
       
  1308 "/                        topFraction:0.0 offset:20
       
  1309 "/                        bottomFraction:1.0 offset:0).
       
  1310 
       
  1311     v := HVScrollableView for:DiffTextView miniScrollerH:true miniScrollerV:false in:diffViewBox.
       
  1312     v layout:(LayoutFrame
       
  1313                         leftFraction:0.0 offset:0
       
  1314                         rightFraction:1.0 offset:0
       
  1315                         topFraction:0.0 offset:20
       
  1316                         bottomFraction:1.0 offset:0).
       
  1317     diffView := v scrolledView.
       
  1318 
       
  1319     self showingDiffs value ifFalse:[
       
  1320         self makeDiffViewInvisible
       
  1321     ].
  1261 
  1322 
  1262     anyChanges := false.
  1323     anyChanges := false.
  1263     ObjectMemory addDependent:self.   "to get shutdown-update"
  1324     ObjectMemory addDependent:self.   "to get shutdown-update"
  1264 
  1325 
  1265     tabSpec := TabulatorSpecification new.
  1326     tabSpec := TabulatorSpecification new.
  1493     ^ className -> changeClass
  1554     ^ className -> changeClass
  1494 !
  1555 !
  1495 
  1556 
  1496 isChangeSetBrowser
  1557 isChangeSetBrowser
  1497     ^ false
  1558     ^ false
       
  1559 !
       
  1560 
       
  1561 makeDiffViewInvisible
       
  1562     diffViewBox lower
       
  1563 !
       
  1564 
       
  1565 makeDiffViewVisible
       
  1566     diffViewBox raise
  1498 !
  1567 !
  1499 
  1568 
  1500 nameSpaceForApply
  1569 nameSpaceForApply
  1501     applyInOriginalNameSpace value ifFalse:[
  1570     applyInOriginalNameSpace value ifFalse:[
  1502         ^ enforcedNameSpace ? Class nameSpaceQuerySignal query.    
  1571         ^ enforcedNameSpace ? Class nameSpaceQuerySignal query.    
  3693     changeIsFollowupMethodChange size >= changeNr ifTrue:[changeIsFollowupMethodChange removeIndex:changeNr].
  3762     changeIsFollowupMethodChange size >= changeNr ifTrue:[changeIsFollowupMethodChange removeIndex:changeNr].
  3694 
  3763 
  3695     "Created: / 7.3.1997 / 16:28:32 / cg"
  3764     "Created: / 7.3.1997 / 16:28:32 / cg"
  3696     "Modified: / 7.2.1998 / 19:59:11 / cg"
  3765     "Modified: / 7.2.1998 / 19:59:11 / cg"
  3697     "Modified: / 26.2.1998 / 18:20:48 / stefan"
  3766     "Modified: / 26.2.1998 / 18:20:48 / stefan"
       
  3767 !
       
  3768 
       
  3769 updateDiffView
       
  3770     self withSelectedChangesDo:[:changeNr |
       
  3771         self updateDiffViewFor:changeNr.
       
  3772         ^ self.
       
  3773     ].
       
  3774 
       
  3775     diffView text1:'' text2:''
       
  3776 !
       
  3777 
       
  3778 updateDiffViewFor:changeNr
       
  3779     |aStream chunk sawExcla parseTree thisClass cat oldSource newSource
       
  3780      parser sel outcome showDiff selector isLoaded
       
  3781      method superClass thisClassSym varsHere varsInChange
       
  3782      ownerClass oldMethod|
       
  3783 
       
  3784     aStream := self streamForChange:changeNr.
       
  3785     aStream isNil ifTrue:[^ self].
       
  3786 
       
  3787     showDiff := false.
       
  3788 
       
  3789     (self changeIsFollowupMethodChange:changeNr) ifFalse:[
       
  3790         sawExcla := aStream peekFor:(aStream class chunkSeparator).
       
  3791         chunk := aStream nextChunk.
       
  3792     ] ifTrue:[
       
  3793         chunk := (changeChunks at:changeNr).
       
  3794         sawExcla := true.
       
  3795     ].
       
  3796 
       
  3797     sawExcla ifFalse:[
       
  3798         Class nameSpaceQuerySignal answer:(self nameSpaceForApply)
       
  3799         do:[
       
  3800             parseTree := Parser parseExpression:chunk.
       
  3801         ].
       
  3802         (parseTree notNil and:[parseTree ~~ #Error and:[ parseTree isMessage ]]) ifTrue:[
       
  3803             selector := parseTree selector.
       
  3804 
       
  3805             selector == #'removeSelector:' ifTrue:[
       
  3806                 thisClass := (parseTree receiver evaluate).
       
  3807                 thisClass isBehavior ifTrue:[
       
  3808                     (self checkClassIsLoaded:thisClass) ifTrue:[
       
  3809                         selector := (parseTree arg1 evaluate).
       
  3810                         (thisClass includesSelector:selector) ifTrue:[
       
  3811                             oldSource := (thisClass compiledMethodAt:selector) source.
       
  3812                             newSource := nil.
       
  3813                         ]
       
  3814                     ] ifFalse:[
       
  3815                         oldSource := newSource := 'Cannot compare this change (compare requires class to be loaded).'.
       
  3816                     ]
       
  3817                 ] ifFalse:[
       
  3818                     oldSource := newSource := 'Cannot compare this change (class not present)'.
       
  3819                 ].
       
  3820             ].
       
  3821 
       
  3822             selector == #'category:' ifTrue:[
       
  3823                 parseTree receiver isMessage ifTrue:[
       
  3824                     parseTree receiver selector == #compiledMethodAt: ifTrue:[
       
  3825                         (method := parseTree receiver evaluate) isMethod ifTrue:[
       
  3826                             method category = parseTree arg1 evaluate ifFalse:[
       
  3827                                 oldSource := chunk.
       
  3828                                 newSource := '(' , method class name , ' compiledMethodAt: ' , method selector storeString , ') category: ' , method category storeString.
       
  3829                             ]
       
  3830                         ] ifFalse:[
       
  3831                             oldSource := newSource := 'There is no such method'.
       
  3832                         ]
       
  3833                     ]
       
  3834                 ]
       
  3835             ].
       
  3836 
       
  3837             selector == #'comment:' ifTrue:[
       
  3838                 thisClass := (parseTree receiver evaluate).
       
  3839                 thisClass isBehavior ifTrue:[
       
  3840                     (self checkClassIsLoaded:thisClass) ifTrue:[
       
  3841                         (thisClass comment = parseTree arg1 evaluate) ifTrue:[
       
  3842                             outcome := 'Change has no effect\\(same comment)'.
       
  3843                         ] ifFalse:[
       
  3844                             oldSource := chunk.
       
  3845                             newSource := thisClass name , ' comment: ' , thisClass comment storeString.
       
  3846                         ]
       
  3847                     ] ifFalse:[
       
  3848                         oldSource := newSource := 'Cannot compare this change (compare requires class to be loaded).'.
       
  3849                     ]
       
  3850                 ] ifFalse:[
       
  3851                     oldSource := newSource := 'Cannot compare this change (class not present)'.
       
  3852                 ].
       
  3853             ].
       
  3854 
       
  3855             selector == #'instanceVariableNames:' ifTrue:[
       
  3856                 parseTree receiver isMessage ifTrue:[
       
  3857                     parseTree receiver selector == #class ifTrue:[
       
  3858                         thisClass := (parseTree receiver evaluate).
       
  3859                         thisClass isBehavior ifTrue:[
       
  3860                             (self checkClassIsLoaded:thisClass) ifTrue:[
       
  3861                                 varsHere := thisClass instanceVariableString asCollectionOfWords.
       
  3862                                 varsInChange := (parseTree arguments at:1) evaluate asCollectionOfWords.
       
  3863                                 varsHere = varsInChange ifTrue:[
       
  3864                                     oldSource := newSource := 'Change has no effect\\(same definition)'.
       
  3865                                 ] ifFalse:[
       
  3866                                     oldSource := chunk.
       
  3867                                     newSource := thisClass definitionString.
       
  3868                                 ].
       
  3869                             ] ifFalse:[
       
  3870                                 oldSource := newSource := 'Cannot compare this change (compare requires class to be loaded).'.
       
  3871                             ].
       
  3872                         ] ifFalse:[
       
  3873                             oldSource := newSource := 'Cannot compare this change (class not present)'.
       
  3874                         ]
       
  3875                     ].
       
  3876                 ]
       
  3877             ].
       
  3878 
       
  3879             (Class definitionSelectors includes:selector)
       
  3880             "/ selector == #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:' 
       
  3881             ifTrue:[
       
  3882                 superClass := (parseTree receiver evaluate).
       
  3883                 superClass isBehavior ifFalse:[
       
  3884                     oldSource := newSource := 'Cannot compare this change\\(superclass not loaded).'.
       
  3885                 ] ifTrue:[
       
  3886                     (self checkClassIsLoaded:superClass) ifTrue:[
       
  3887                         thisClassSym := (parseTree arguments at:1) evaluate.
       
  3888 
       
  3889                         (selector endsWith:':privateIn:') ifTrue:[
       
  3890                             ownerClass := (parseTree arguments at:5) evaluate.
       
  3891                             thisClass := ownerClass privateClassesAt:thisClassSym.
       
  3892                         ] ifFalse:[
       
  3893                             thisClass := (self nameSpaceForApply) at:thisClassSym ifAbsent:nil.
       
  3894                         ].
       
  3895                         thisClass isNil ifTrue:[
       
  3896                             oldSource := newSource := 'Change defines the class: ' , thisClassSym allBold.
       
  3897                         ] ifFalse:[
       
  3898                             (isLoaded := self checkClassIsLoaded:thisClass) ifFalse:[
       
  3899                                 oldSource := newSource := 'Cannot compare this change\\(compare requires class to be loaded).'.
       
  3900                             ] ifTrue:[
       
  3901                                 oldSource := chunk.
       
  3902                                 newSource := thisClass definitionString.
       
  3903                             ]
       
  3904                         ]
       
  3905                     ]
       
  3906                 ]
       
  3907             ]
       
  3908         ]
       
  3909     ] ifTrue:[
       
  3910         Class nameSpaceQuerySignal answer:(self nameSpaceForApply)
       
  3911         do:[
       
  3912             parseTree := Parser parseExpression:chunk.
       
  3913         ].
       
  3914         (parseTree notNil 
       
  3915          and:[parseTree ~~ #Error
       
  3916          and:[parseTree isMessage]]) ifTrue:[
       
  3917             "/ Squeak support (#methodsFor:***)
       
  3918             (#(
       
  3919                #methodsFor: 
       
  3920                #privateMethodsFor:
       
  3921                #publicMethodsFor:
       
  3922                #ignoredMethodsFor:
       
  3923                #protectedMethodsFor:
       
  3924 
       
  3925                #methodsFor:stamp:             "/ Squeak support
       
  3926                #methodsFor                    "/ Dolphin support
       
  3927                #methods                       "/ STV support
       
  3928               ) 
       
  3929             includes:parseTree selector) ifTrue:[
       
  3930                 thisClass := (parseTree receiver evaluate).
       
  3931                 thisClass isBehavior ifTrue:[
       
  3932                     (isLoaded := self checkClassIsLoaded:thisClass) ifFalse:[
       
  3933                         oldSource := newSource := 'Cannot compare this change\\(compare requires class to be loaded).'.
       
  3934                     ] ifTrue:[
       
  3935                         parseTree selector == #methodsFor ifTrue:[
       
  3936                             cat := 'Dolphin methods'.
       
  3937                         ] ifFalse:[
       
  3938                             parseTree selector == #methods ifTrue:[
       
  3939                                 cat := 'STV methods'.
       
  3940                             ] ifFalse:[
       
  3941                                 cat := parseTree arg1 evaluate.
       
  3942                             ].
       
  3943                         ].
       
  3944                         newSource := aStream nextChunk.
       
  3945 
       
  3946                         Class nameSpaceQuerySignal answer:(self nameSpaceForApply)
       
  3947                         do:[
       
  3948                             parser := Parser parseMethod:newSource in:thisClass.
       
  3949                         ].
       
  3950                         (parser notNil and:[parser ~~ #Error]) ifTrue:[
       
  3951                             sel := parser selector.
       
  3952                             oldMethod := thisClass compiledMethodAt:sel.
       
  3953                             oldMethod notNil ifTrue:[
       
  3954                                 (oldMethod category = cat) ifFalse:[
       
  3955                                     Transcript showCR:'category changed.'.
       
  3956                                 ].
       
  3957                                 oldSource := oldMethod source.
       
  3958                                 (oldSource = newSource) ifFalse:[
       
  3959                                     oldSource isNil ifTrue:[
       
  3960                                         oldSource := newSource := 'No source for compare.'.
       
  3961                                     ] ifFalse:[
       
  3962                                         "/
       
  3963                                         "/ compare for tabulator <-> space changes
       
  3964                                         "/ before showing diff ...
       
  3965                                         "/
       
  3966                                         oldSource := oldSource asCollectionOfLines collect:[:s | s withTabsExpanded].
       
  3967                                         newSource := newSource asCollectionOfLines collect:[:s | s withTabsExpanded].
       
  3968                                         oldSource = newSource ifFalse:[
       
  3969                                             "/
       
  3970                                             "/ check if only historyLine diffs
       
  3971                                             "/
       
  3972                                             (HistoryManager notNil 
       
  3973                                             and:[HistoryManager isActive]) ifTrue:[
       
  3974                                                 (HistoryManager withoutHistoryLines:newSource)
       
  3975                                                 =
       
  3976                                                 (HistoryManager withoutHistoryLines:oldSource)
       
  3977                                                 ifTrue:[
       
  3978                                                     oldSource := (HistoryManager withoutHistoryLines:oldSource).
       
  3979                                                     newSource := (HistoryManager withoutHistoryLines:newSource).
       
  3980                                                 ]
       
  3981                                             ].
       
  3982                                         ]
       
  3983                                     ]
       
  3984                                 ]
       
  3985                             ] ifFalse:[
       
  3986                                 isLoaded ifTrue:[
       
  3987                                     oldSource := newSource := 'Method does not exist.'.
       
  3988                                 ]
       
  3989                             ]
       
  3990                         ] ifFalse:[
       
  3991                             oldSource := newSource := 'Change is unparsable (parse error).'.
       
  3992                         ].
       
  3993                     ].
       
  3994                 ] ifFalse:[
       
  3995                     oldSource := newSource := 'Class does not exist.'.
       
  3996                 ]
       
  3997             ] ifFalse:[
       
  3998                 oldSource := newSource := 'Not comparable.'.
       
  3999             ]
       
  4000         ] ifFalse:[
       
  4001             oldSource := newSource := 'Not comparable.'.
       
  4002         ]
       
  4003     ].
       
  4004     aStream close.
       
  4005 
       
  4006     diffView text1:(oldSource ? '') text2:(newSource ? '').
       
  4007 
       
  4008     "Created: / 24.11.1995 / 14:30:46 / cg"
       
  4009     "Modified: / 13.2.2000 / 15:04:39 / cg"
  3698 ! !
  4010 ! !
  3699 
  4011 
  3700 !ChangesBrowser methodsFor:'termination'!
  4012 !ChangesBrowser methodsFor:'termination'!
  3701 
  4013 
  3702 askIfChangesAreToBeWrittenBack
  4014 askIfChangesAreToBeWrittenBack
  3861             notifying:self 
  4173             notifying:self 
  3862             logged:true 
  4174             logged:true 
  3863             ifFail:nil 
  4175             ifFail:nil 
  3864     ].
  4176     ].
  3865     changeNrShown := lineNr.
  4177     changeNrShown := lineNr.
       
  4178 
       
  4179     self showingDiffs value ifTrue:[
       
  4180         self updateDiffViewFor:changeNrShown.
       
  4181     ].
  3866 
  4182 
  3867     "Modified: / 28.2.1999 / 15:26:46 / cg"
  4183     "Modified: / 28.2.1999 / 15:26:46 / cg"
  3868 !
  4184 !
  3869 
  4185 
  3870 classOfChange:changeNr
  4186 classOfChange:changeNr
  5134 ! !
  5450 ! !
  5135 
  5451 
  5136 !ChangesBrowser class methodsFor:'documentation'!
  5452 !ChangesBrowser class methodsFor:'documentation'!
  5137 
  5453 
  5138 version
  5454 version
  5139     ^ '$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.283 2003-01-26 14:11:16 cg Exp $'
  5455     ^ '$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.284 2003-01-27 10:46:27 penk Exp $'
  5140 ! !
  5456 ! !