diff -r 3106c0de1707 -r 57c1ccc3d7e0 ChangesBrowser.st --- a/ChangesBrowser.st Tue Nov 01 14:18:24 1994 +0100 +++ b/ChangesBrowser.st Thu Nov 17 15:44:34 1994 +0100 @@ -10,12 +10,12 @@ hereby transferred. " -'From Smalltalk/X, Version:2.10.3 on 26-sep-1994 at 1:19:22 pm'! +'From Smalltalk/X, Version:2.10.4 on 6-nov-1994 at 21:36:13'! StandardSystemView subclass:#ChangesBrowser instanceVariableNames:'changeListView codeView changeFileName changeChunks changePositions changeClassNames changeHeaderLines anyChanges - changeNrShown changeNrProcessed fileBox skipSignal' + changeNrShown changeNrProcessed skipSignal' classVariableNames:'' poolDictionaries:'' category:'Interface-Browsers' @@ -25,7 +25,7 @@ COPYRIGHT (c) 1990 by Claus Gittinger All Rights Reserved -$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.18 1994-11-01 13:18:24 claus Exp $ +$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.19 1994-11-17 14:44:05 claus Exp $ '! !ChangesBrowser class methodsFor:'documentation'! @@ -46,7 +46,7 @@ version " -$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.18 1994-11-01 13:18:24 claus Exp $ +$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.19 1994-11-17 14:44:05 claus Exp $ " ! @@ -56,9 +56,22 @@ See the extra document 'doc/misc/cbrowser.doc' for how to use this browser. written jan 90 by claus + + Notice: + this needs a total rewrite, to build up a changeSet from the file + (which did not exist when the ChangesBrowser was written) and + manipulate that changeSet. + This ways, we get a browser for any upcoming incore changeSets for + free. " ! ! +!ChangesBrowser class methodsFor:'defaults'! + +defaultLabel + ^ 'Changes Browser' +! ! + !ChangesBrowser class methodsFor:'instance creation'! new @@ -83,170 +96,47 @@ ^ true ! ! -!ChangesBrowser methodsFor:'initialize / release'! - -initializeMiddleButtonMenu - |labels| +!ChangesBrowser methodsFor:'menu stuff'! - 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' - 'browse class' - '-' - 'make change a patch' -"/ 'update sourcefile from change' -"/ '-' - 'save change in file ...' - 'save changes to end in file ...' - 'save changes for this class to end in file ...' - 'save all changes for this class in file ...' - '-' - 'writeback changeFile'). +disableMenuEntries + "enable all entries refering to a selected change" - changeListView - middleButtonMenu:(PopUpMenu - labels:labels - selectors:#( - doApply - doApplyRest - doApplyAll - nil - doDelete - doDeleteRest - doDeleteClassRest - doDeleteClassAll - nil - doUpdate - doCompress - doCompare - doBrowse - nil - doMakePatch -"/ doMakePermanent -"/ nil - doSave - doSaveRest - doSaveClassRest - doSaveClassAll - nil - doWriteBack) - receiver:self - for:changeListView) + #(doApply doApplyClassRest doApplyRest doDelete doDeleteRest doDeleteClassRest + doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent + doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse) + do:[:sel | + changeListView middleButtonMenu disable:sel + ]. ! -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 := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:frame. - v origin:(0.0 @ 0.3) corner:(1.0 @ 1.0). - codeView := v scrolledView. - codeView readOnly. - - anyChanges := false. - ObjectMemory addDependent:self. "to get shutdown-update" -! - -realize - super realize. - self readChangesFileInBackground:true. - self setChangeList. - changeListView action:[:lineNr | self changeSelection:lineNr]. - self disableMenuEntries. -! - -update:what - |box| - - (what == #aboutToExit) ifTrue:[ - " - smalltalk is about to shut down - - - if change list was modified, ask user and save if requested. - " - anyChanges ifTrue:[ - shown ifFalse:[ - self unrealize. - self realize - ]. - self raise. +enableMenuEntries + "enable all entries refering to a selected change" - box := YesNoBox new. - box title:(resources at:'ChangesBrowser:\changefile has not been updated from the modified changelist.\\Update before exiting ?') withCRs. - box noText:(resources at:'don''t update'). - box okText:(resources at:'update'). - box yesAction:[self writeBackChanges] - noAction:[]. - box showAtPointer - ]. - ^ self + #(doApply doApplyClassRest doApplyRest + doDelete doDeleteRest doDeleteClassRest + doDeleteClassAll + doCompare doMakePatch doSaveChangeInFile doMakePermanent + doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse) + do:[:sel | + changeListView middleButtonMenu enable:sel ]. - super update:what -! ! - -!ChangesBrowser methodsFor:'termination'! - -terminate - "window manager wants us to go away" - - |box| - - anyChanges ifTrue:[ - box := OptionBox title:'' numberOfOptions:3. - box title:(resources at:'close ChangesBrowser.\\changefile has not been updated from the modified changelist.\\Update before closing ?') withCRs. - box buttonTitles:(resources array:#('abort' 'don''t update' 'update')). - box actions:(Array with:[^ self] - with:[self destroy] - with:[self writeBackChanges. self destroy] - ). - box showAtPointer. - ] ifFalse:[ - self destroy - ] -! - -destroy - "destroy the receiver; make certain, that boxes are destroyed too" - - ObjectMemory removeDependent:self. - fileBox notNil ifTrue:[fileBox destroy. fileBox := nil]. - super destroy -! - -saveAndTerminate - "update the changes file and quit. - Dont depend on this being sent, not all window managers - send it; instead, they simply destroy the view." - - anyChanges ifTrue:[ - self writeBackChanges. - ]. - self destroy ! ! !ChangesBrowser methodsFor:'private'! +clearCodeView + self unselect "changeListView deselect". + codeView contents:nil. + changeNrShown := nil +! + +unselect + "common unselect" + + changeListView deselect. + self disableMenuEntries +! + streamForChange:changeNr "answer a stream for change" @@ -258,93 +148,83 @@ ^ aStream ! -enableMenuEntries - "enable all entries refering to a selected change" +applyChange:changeNr + "fileIn a change" + + |aStream upd nm| - #(doApply doApplyRest doDelete doDeleteRest doDeleteClassRest - doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent - doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse) - do:[:sel | - changeListView middleButtonMenu enable:sel - ]. -! + aStream := self streamForChange:changeNr. + aStream isNil ifTrue:[^ self]. + + nm := self classNameOfChange:changeNr. + nm notNil ifTrue:[ + |cls| -unselect - "common unselect" + cls := Smalltalk at:(nm asSymbol) ifAbsent:[]. + cls notNil ifTrue:[ + cls isLoaded ifFalse:[ + cls autoload + ] + ] + ]. - changeListView deselect. - self disableMenuEntries -! + changeNrProcessed := changeNr. -disableMenuEntries - "enable all entries refering to a selected change" + upd := Class updateChanges:false. + [ + |sig| - #(doApply doApplyRest doDelete doDeleteRest doDeleteClassRest - doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent - doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse) - do:[:sel | - changeListView middleButtonMenu disable:sel + (skipSignal notNil) ifTrue:[ + sig := skipSignal + ] ifFalse:[ + sig := Object abortSignal + ]. + sig catch:[ + aStream fileInNextChunkNotifying:self + ]. + changeNrProcessed := nil. + ] valueNowOrOnUnwindDo:[ + Class updateChanges:upd. + aStream close ]. ! -clearCodeView - self unselect "changeListView deselect". - codeView contents:nil. - changeNrShown := nil -! +setChangeList + "extract type-information from changes and stuff into top selection + view" -autoSelect:changeNr - self class autoSelectNext ifTrue:[ - (changeNr <= changePositions size) ifTrue:[ - self clearCodeView. - changeListView selection:changeNr. - self changeSelection:changeNr. - ^ self - ] - ]. - self clearCodeView + changeListView setList:changeHeaderLines expandTabs:false. + "/ changeListView deselect. + self disableMenuEntries ! -autoSelectOrEnd:changeNr - |last| - - last := changePositions size. - changeNr < last ifTrue:[ - self autoSelect:changeNr - ] ifFalse:[ - self clearCodeView. - changeListView selection:last . - self changeSelection:last . - ] -! - -contractClass:className selector:selector to:maxLen - |s l| +silentDeleteChange:changeNr + "delete a change do not update changeListView" - s := className , ' ', selector. - s size > maxLen ifTrue:[ - l := maxLen - 1 - selector size max:20. - s := (className contractTo:l) , ' ' , selector. - - s size > maxLen ifTrue:[ - l := maxLen - 1 - className size max:20. - s := className , ' ', (selector contractTo:l). - - s size > maxLen ifTrue:[ - s := (className contractTo:(maxLen // 2 - 1)) , ' ' , (selector contractTo:maxLen // 2) - ] - ] - ]. - ^ s + anyChanges := true. + changeChunks removeIndex:changeNr. + changePositions removeIndex:changeNr. + changeClassNames removeIndex:changeNr. + changeHeaderLines removeIndex:changeNr ! readChangesFileInBackground:inBackground "read the changes file, create a list of header-lines (changeChunks) - and a list of chunk-positions (changePositions)" + and a list of chunk-positions (changePositions). + Starting with 2.10.3, the entries are multi-col entries; + the cols are: + 1 class/selector + 2 delta + '+' -> new method (w.r.t. current state) + '-' -> removed method (w.r.t. current state) + '?' -> class does not exist currently + 3 type of change + doit + method + category change + " - |aStream index chunkText headerLine done sawExcla chunkPos excla - myProcess myPriority p sel cls text first category tabSpec entry - maxLen| + |aStream maxLen| maxLen := 60. @@ -352,11 +232,13 @@ aStream isNil ifTrue:[^ nil]. self withCursor:(Cursor read) do:[ + |tabSpec myProcess myPriority| + tabSpec := TabulatorSpecification new. tabSpec unit:#inch. - tabSpec positions:#(0 4.5 5.5 ). - " cls>>sel type info " - tabSpec align: #(#left #left #left). + tabSpec positions:#(0 4.5 4.65 5.5 ). + " cls>>sel +/- type info" + tabSpec align: #(#left #left #left #left). " this is a time consuming operation (especially, if reading an @@ -367,8 +249,9 @@ myPriority := myProcess priority. myProcess priority:(Processor userBackgroundPriority). ]. + [ - |entry changeString changeType line s l| + |excla| changeChunks := OrderedCollection new. changeHeaderLines := OrderedCollection new. @@ -376,6 +259,10 @@ excla := aStream class chunkSeparator. [aStream atEnd] whileFalse:[ + |entry changeDelta changeString changeType + line s l changeClass sawExcla category + chunkText chunkPos| + " get a chunk (separated by excla) " @@ -384,6 +271,8 @@ sawExcla := aStream peekFor:excla. chunkText := aStream nextChunk. chunkText notNil ifTrue:[ + |index headerLine| + " only first line is saved in changeChunks ... " @@ -403,34 +292,70 @@ changeChunks add:chunkText. changePositions add:chunkPos. headerLine := nil. + changeDelta := ' '. sawExcla ifFalse:[ - (chunkText startsWith:'''---- snap') ifFalse:[ + (chunkText startsWith:'''---- snap') ifTrue:[ + changeType := ''. + headerLine := chunkText. + changeString := (chunkText contractTo:maxLen). + ] ifFalse:[ + |p sel cls| + headerLine := chunkText , ' (doIt)'. - entry := MultiColListEntry new. - + " + first, assume doIt - then lets have a more detailed look ... + " changeType := '(doIt)'. changeString := (chunkText contractTo:maxLen). + p := Parser parseExpression:chunkText. - (p notNil and:[p ~~ #Error]) ifTrue:[ + (p notNil + and:[p ~~ #Error + and:[p isMessage]]) ifTrue:[ sel := p selector. - (sel == #removeSelector:) ifTrue:[ - p receiver isUnaryMessage ifTrue:[ + ]. + (sel == #removeSelector:) ifTrue:[ + p receiver isUnaryMessage ifTrue:[ + cls := p receiver receiver name. + changeClass := (Smalltalk classNamed:cls) class. + cls := cls , ' class'. + ] ifFalse:[ + cls := p receiver name. + changeClass := (Smalltalk classNamed:cls) + ]. + sel := (p args at:1) evaluate. + (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[ + changeDelta := '?' + ] ifFalse:[ + (changeClass implements:sel asSymbol) ifTrue:[ + changeDelta := '-'. + ] + ]. + changeType := '(remove)'. + changeString := self contractClass:cls selector:sel to:maxLen. + ]. + (sel == #category:) ifTrue:[ + (p receiver isMessage + and:[p receiver selector == #compiledMethodAt:]) ifTrue:[ + p receiver receiver isUnaryMessage ifTrue:[ + cls := p receiver receiver receiver name. + changeClass := (Smalltalk classNamed:cls) class. + cls := cls , ' class'. + ] ifFalse:[ cls := p receiver receiver name. - cls := cls , 'class' - ] ifFalse:[ - cls := p receiver name + changeClass := (Smalltalk classNamed:cls) ]. - sel := (p args at:1) evaluate. - changeType := '(remove)'. + sel := (p receiver args at:1) evaluate. + changeType := '(category change)'. changeString := self contractClass:cls selector:sel to:maxLen. ] - ]. - ] ifTrue:[ - headerLine := chunkText + ] ]. ] ifTrue:[ + |done first p sel cls text| + " method definitions actually consist of two (or more) chunks; skip next chunk(s) @@ -446,9 +371,11 @@ (sel == #methodsFor:) ifTrue:[ p receiver isUnaryMessage ifTrue:[ cls := p receiver receiver name. - cls := cls , 'class' + changeClass := (Smalltalk classNamed:cls) class. + cls := cls , ' class'. ] ifFalse:[ - cls := p receiver name + cls := p receiver name. + changeClass := Smalltalk classNamed:cls ]. category := (p args at:1) evaluate. ]. @@ -482,7 +409,6 @@ ] ]. - entry := MultiColListEntry new. sel isNil ifTrue:[ changeString := (chunkText contractTo:maxLen). changeType := '(change)'. @@ -494,15 +420,24 @@ headerLine := chunkText , ' (change)'. ] ifFalse:[ headerLine := cls , ' ' , sel , ' ' , '(change category: ''' , category , ''')'. + ]. + (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[ + changeDelta := '?' + ] ifFalse:[ + (changeClass implements:sel asSymbol) ifFalse:[ + changeDelta := '+'. + ] ] ] ] ] ]. - entry notNil ifTrue:[ + changeString notNil ifTrue:[ + entry := MultiColListEntry new. entry tabulatorSpecification:tabSpec. entry colAt:1 put:changeString. - entry colAt:2 put:changeType. + entry colAt:2 put:changeDelta. + entry colAt:3 put:changeType. changeHeaderLines add:entry ] ifFalse:[ headerLine notNil ifTrue:[ @@ -520,76 +455,178 @@ ] ! -queryCloseText - "made this a method for easy redefinition in subclasses" +contractClass:className selector:selector to:maxLen + |s l| + + s := className , ' ', selector. + s size > maxLen ifTrue:[ + l := maxLen - 1 - selector size max:20. + s := (className contractTo:l) , ' ' , selector. + + s size > maxLen ifTrue:[ + l := maxLen - 1 - className size max:20. + s := className , ' ', (selector contractTo:l). - ^ 'Quit without updating changeFile ?' + s size > maxLen ifTrue:[ + s := (className contractTo:(maxLen // 2 - 1)) , ' ' , (selector contractTo:maxLen // 2) + ] + ] + ]. + ^ s +! + +autoSelect:changeNr + self class autoSelectNext ifTrue:[ + (changeNr <= changePositions size) ifTrue:[ + self clearCodeView. + changeListView selection:changeNr. + self changeSelection:changeNr. + ^ self + ] + ]. + self clearCodeView ! -applyChange:changeNr - "fileIn a change" +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 isNil ifTrue:[^ nil]. + + " + first look, if not already known + " + name := changeClassNames at:changeNr. + name notNil ifTrue:[^ name]. - |aStream upd sig nm cls| + " + get the chunk + " + chunk := changeChunks at:changeNr. + chunk isNil ifTrue:[^ nil]. "mhmh - empty" - aStream := self streamForChange:changeNr. - aStream isNil ifTrue:[^ self]. + " + use parser to construct a parseTree + " + aParseTree := Parser parseExpression:chunk. + (aParseTree isNil or:[aParseTree == #Error]) ifTrue:[ + ^ nil "seems strange ... (could be a comment)" + ]. + aParseTree isMessage ifFalse:[ + ^ nil "very strange ... (whats that ?)" + ]. + + " + ask parser for selector + " + sel := aParseTree selector. + recTree := aParseTree receiver. - nm := self classNameOfChange:changeNr. - nm notNil ifTrue:[ - cls := Smalltalk at:(nm asSymbol) ifAbsent:[]. - cls notNil ifTrue:[ - cls isLoaded ifFalse:[ - cls autoload + " + is it a method-change, methodRemove or comment-change ? + " + (#(#'methodsFor:' + #'privateMethodsFor:' + #'protectedMethodsFor:' + #'publicMethodsFor:' + #'removeSelector:' + #'comment:' + #'renameCategory:to:' + ) includes:sel) ifTrue:[ + " + yes, the className is the receiver + " + (recTree notNil and:[recTree ~~ #Error]) ifTrue:[ + recTree isUnaryMessage ifTrue:[ + (recTree selector ~~ #class) ifTrue:[^ nil]. + "id class methodsFor:..." + recTree := recTree receiver + ]. + recTree isPrimary ifTrue:[ + name := recTree name. + changeClassNames at:changeNr put:name. + ^ name ] + ]. + "more strange things" + ^ nil + ]. + + " + is it a change in a class-description ? + " + ('subclass:*' match:sel) ifTrue:[ + arg1Tree := aParseTree arg1. + (arg1Tree notNil and:[arg1Tree isConstant]) ifTrue:[ + name := arg1Tree value asString. + changeClassNames at:changeNr put:name. + ^ name + ]. + "very strange" + ^ nil + ]. + + " + is it a class remove ? + " + (sel == #removeClass:) ifTrue:[ + (recTree notNil + and:[recTree ~~ #Error + and:[recTree isPrimary + and:[recTree name = 'Smalltalk']]]) ifTrue:[ + arg1Tree := aParseTree arg1. + (arg1Tree notNil and:[arg1Tree isPrimary]) ifTrue:[ + name := arg1Tree name. + changeClassNames at:changeNr put:name. + ^ name + ]. ] ]. - upd := Class updateChanges:false. - - changeNrProcessed := changeNr. - [ - (skipSignal notNil) ifTrue:[ - sig := skipSignal - ] ifFalse:[ - sig := Object abortSignal - ]. - sig catch:[ - aStream fileInNextChunkNotifying:self - ]. - changeNrProcessed := nil. - ] valueNowOrOnUnwindDo:[ - Class updateChanges:upd. - aStream close + " + is it a method category change ? + " + (sel == #category:) ifTrue:[ + (recTree notNil + and:[recTree ~~ #Error + and:[recTree isMessage + and:[recTree selector == #compiledMethodAt:]]]) ifTrue:[ + recTree := recTree receiver. + recTree isUnaryMessage ifTrue:[ + (recTree selector ~~ #class) ifTrue:[^ nil]. + "id class " + recTree := recTree receiver + ]. + recTree isPrimary ifTrue:[ + name := recTree name. + changeClassNames at:changeNr put:name. + ^ name + ] + ] ]. + ^ nil ! -changeFileName:aFileName - changeFileName := aFileName -! - -setChangeList - "extract type-information from changes and stuff into top selection - view" +autoSelectOrEnd:changeNr + |last| -"/ changeListView list:changeHeaderLines "changeChunks". -changeListView setList:changeHeaderLines expandTabs:false. - self disableMenuEntries -! - -silentDeleteChange:changeNr - "delete a change do not update changeListView" - - anyChanges := true. - changeChunks removeIndex:changeNr. - changePositions removeIndex:changeNr. - changeClassNames removeIndex:changeNr. - changeHeaderLines removeIndex:changeNr + last := changePositions size. + changeNr < last ifTrue:[ + self autoSelect:changeNr + ] ifFalse:[ + self clearCodeView. + changeListView selection:last . + self changeSelection:last . + ] ! writeBackChanges "write back the changes file" - |inStream outStream chunk sawExcla excla done dir| + |inStream outStream| outStream := FileStream newFileNamed:'n_changes'. outStream isNil ifTrue:[ @@ -601,8 +638,13 @@ inStream isNil ifTrue:[^ nil]. self withCursor:(Cursor write) do:[ + |excla sawExcla done dir chunk + nChanges "{Class:SmallInteger}" | + excla := inStream class chunkSeparator. - 1 to:(changePositions size) do:[:index | + nChanges := changePositions size. + + 1 to:nChanges do:[:index | inStream position:(changePositions at:index). sawExcla := inStream peekFor:excla. chunk := inStream nextChunk. @@ -611,7 +653,9 @@ outStream nextPut:excla. outStream nextChunkPut:chunk. outStream cr. - "a method-definition chunk - skip followups" + " + a method-definition chunk - skip followups + " done := false. [done] whileFalse:[ chunk := inStream nextChunk. @@ -631,8 +675,7 @@ outStream close. inStream close. dir := FileDirectory currentDirectory. -"/ dir removeFile:changeFileName. - dir renameFile:'changes' newName:'changes.bak'. + dir renameFile:changeFileName newName:'changes.bak'. dir renameFile:'n_changes' newName:changeFileName. anyChanges := false ] @@ -643,94 +686,14 @@ changeListView deselect. self silentDeleteChange:changeNr. - self setChangeList "/changeListView setContents:changeChunks + self setChangeList ! -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:[ - " - first look, if not already known - " - name := changeClassNames at:changeNr. - name notNil ifTrue:[^ name]. +queryCloseText + "made this a method for easy redefinition in subclasses" - " - get the chunk - " - chunk := changeChunks at:changeNr. - chunk notNil ifTrue:[ - " - use parser to construct a parseTree - " - aParseTree := Parser parseExpression:chunk. - (aParseTree notNil and:[aParseTree isMessage]) ifTrue:[ - " - ask parser for selector - " - sel := aParseTree selector. - " - is it a method-change, methodRemove or comment-change ? - " - (#(methodsFor: privateMethodsFor: publicMethodsFor: - removeSelector: comment:) includes:sel) ifTrue:[ - " - yes, the className is the receiver - " - recTree := aParseTree receiver. - (recTree notNil and:[recTree ~~ #Error]) ifTrue:[ - recTree isUnaryMessage ifTrue:[ - (recTree selector ~~ #class) ifTrue:[^ nil]. - "id class methodsFor:..." - recTree := recTree receiver - ]. - recTree isPrimary ifTrue:[ - name := recTree name. - changeClassNames at:changeNr put:name. - ^ name - ] - ] - ] ifFalse:[ - " - is it a change in a class-description ? - " - ('subclass:*' match:sel) ifTrue:[ - arg1Tree := aParseTree arg1. - (arg1Tree notNil and:[arg1Tree isConstant]) ifTrue:[ - name := arg1Tree value asString. - changeClassNames at:changeNr put:name. - ^ name - ] - ] - ] - ] - ] - ]. - ^ nil -! - -deleteChangesFrom:start to:stop - "delete a range of changes" - - changeListView deselect. - stop to:start by:-1 do:[:changeNr | - self silentDeleteChange:changeNr - ]. - self setChangeList "/changeListView setContents:changeChunks - -! - -readChangesFile - "read the changes file, create a list of header-lines (changeChunks) - and a list of chunk-positions (changePositions)" - - ^ self readChangesFileInBackground:false + ^ 'Quit without updating changeFile ?' ! compareChange:changeNr @@ -794,6 +757,28 @@ aStream close. ! +deleteChangesFrom:start to:stop + "delete a range of changes" + + changeListView deselect. + stop to:start by:-1 do:[:changeNr | + self silentDeleteChange:changeNr + ]. + self setChangeList + +! + +changeFileName:aFileName + changeFileName := aFileName +! + +readChangesFile + "read the changes file, create a list of header-lines (changeChunks) + and a list of chunk-positions (changePositions)" + + ^ self readChangesFileInBackground:false +! + appendChange:changeNr toFile:fileName "append change to a file. return true if ok." @@ -868,6 +853,130 @@ ! ! +!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 := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:frame. + v origin:(0.0 @ 0.3) corner:(1.0 @ 1.0). + codeView := v scrolledView. + codeView readOnly. + + anyChanges := false. + ObjectMemory addDependent:self. "to get shutdown-update" +! + +initializeMiddleButtonMenu + |labels| + + labels := resources array:#( + 'apply change' + 'apply changes to end' + 'apply changes for this class 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' + 'browse class' + '-' + 'make change a patch' +"/ 'update sourcefile from change' +"/ '-' + 'save change in file ...' + 'save changes to end in file ...' + 'save changes for this class to end in file ...' + 'save all changes for this class in file ...' + '-' + 'writeback changeFile'). + + changeListView + middleButtonMenu:(PopUpMenu + labels:labels + selectors:#( + doApply + doApplyRest + doApplyClassRest + doApplyAll + nil + doDelete + doDeleteRest + doDeleteClassRest + doDeleteClassAll + nil + doUpdate + doCompress + doCompare + doBrowse + nil + doMakePatch +"/ doMakePermanent +"/ nil + doSave + doSaveRest + doSaveClassRest + doSaveClassAll + nil + doWriteBack) + receiver:self + for:changeListView) +! + +realize + super realize. + self readChangesFileInBackground:true. + self setChangeList. + changeListView action:[:lineNr | self changeSelection:lineNr]. + self disableMenuEntries. +! + +update:what + |box| + + (what == #aboutToExit) ifTrue:[ + " + smalltalk is about to shut down - + - if change list was modified, ask user and save if requested. + " + anyChanges ifTrue:[ + shown ifFalse:[ + self unrealize. + self realize + ]. + self raise. + + box := YesNoBox new. + box title:(resources at:'ChangesBrowser:\changefile has not been updated from the modified changelist.\\Update before exiting ?') withCRs. + box noText:(resources at:'don''t update'). + box okText:(resources at:'update'). + box yesAction:[self writeBackChanges] + noAction:[]. + box showAtPointer + ]. + ^ self + ]. + super update:what +! ! + !ChangesBrowser methodsFor:'user interaction'! changeSelection:lineNr @@ -889,6 +998,21 @@ self enableMenuEntries ! +doApply + "user wants a change to be applied" + + |changeNr| + + changeNr := changeListView selection. + changeNr notNil ifTrue:[ + self withCursor:(Cursor execute) do:[ + skipSignal := nil. + self applyChange:changeNr. + self autoSelect:(changeNr + 1) + ] + ] +! + noChangesAllowed "show a warning that changes cannot be changed" @@ -907,21 +1031,6 @@ self doSaveClassFrom:1 ! -doApply - "user wants a change to be applied" - - |changeNr| - - changeNr := changeListView selection. - changeNr notNil ifTrue:[ - self withCursor:(Cursor execute) do:[ - skipSignal := nil. - self applyChange:changeNr. - self autoSelect:(changeNr + 1) - ] - ] -! - doSaveClassRest "user wants changes for some class from current to end to be appended to a file" @@ -933,37 +1042,6 @@ ] ! -saveClass:aClassName from:startNr - "user wants changes from current to end to be appended to a file" - - |changeNr classNameToSave fileBox| - - changeNr := changeListView selection. - changeNr notNil ifTrue:[ - fileBox := FileSelectionBox new. - fileBox title:'append change to:'. - fileBox okText:'append'. - fileBox abortText:'cancel'. - fileBox action:[:fileName | - |thisClassName| - self withCursor:(Cursor write) do:[ - startNr to:(changePositions size) do:[:changeNr | - thisClassName := self classNameOfChange:changeNr. - thisClassName = aClassName ifTrue:[ - changeListView selection:changeNr. - (self appendChange:changeNr toFile:fileName) ifFalse:[ - ^ self - ] - ] - ] - ] - ]. - - fileBox pattern:'*.chg'. - fileBox showAtPointer - ] -! - doBrowse "user wants a browser on the class of a change" @@ -980,6 +1058,38 @@ ] ! +saveClass:aClassName from:startNr + "user wants changes from current to end to be appended to a file" + + |changeNr fileBox| + + changeNr := changeListView selection. + changeNr notNil ifTrue:[ + fileBox := FileSelectionBox new. + fileBox title:'append change to:'. + fileBox okText:'append'. + fileBox abortText:'cancel'. + fileBox action:[:fileName | + |thisClassName| + + self withCursor:(Cursor write) do:[ + startNr to:(changePositions size) do:[:changeNr | + thisClassName := self classNameOfChange:changeNr. + thisClassName = aClassName ifTrue:[ + changeListView selection:changeNr. + (self appendChange:changeNr toFile:fileName) ifFalse:[ + ^ self + ] + ] + ] + ] + ]. + + fileBox pattern:'*.chg'. + fileBox showAtPointer + ] +! + doSaveClassFrom:startNr "user wants changes from current to end to be appended to a file" @@ -1021,6 +1131,18 @@ ] ! +doDelete + "delete currently selected change" + + |changeNr| + + changeNr := changeListView selection. + changeNr notNil ifTrue:[ + self deleteChange:changeNr. + self autoSelectOrEnd:changeNr + ] +! + doSave "user wants a change to be appended to a file" @@ -1044,17 +1166,28 @@ ] ! +doUpdate + "reread the changes-file" + + self readChangesFileInBackground:true. + realized ifTrue:[ + self setChangeList. + changeListView hasSelection ifTrue:[self enableMenuEntries] + ] +! + doMakePermanent "user wants a change to be made permanent - rewrite the source file where this change has to go" - |changeNr yesNoBox| + |yesNoBox| yesNoBox := YesNoBox new. yesNoBox title:(resources at:'Warning: this operation cannot be undone'). yesNoBox okText:(resources at:'continue'). yesNoBox noText:(resources at:'abort'). - yesNoBox okAction:[ + yesNoBox okAction:[ |changeNr| + changeNr := changeListView selection. changeNr notNil ifTrue:[ self makeChangePermanent:changeNr. @@ -1077,18 +1210,6 @@ ] ! -doDelete - "delete currently selected change" - - |changeNr| - - changeNr := changeListView selection. - changeNr notNil ifTrue:[ - self deleteChange:changeNr. - self autoSelectOrEnd:changeNr - ] -! - doApplyRest "user wants all changes from changeNr to be applied" @@ -1099,50 +1220,10 @@ self withCursor:(Cursor execute) do:[ self clearCodeView. skipSignal isNil ifTrue:[skipSignal := Signal new]. -"/ Object abortSignal catch:[ - changeNr to:(changePositions size) do:[:changeNr | - changeListView selection:changeNr. - self applyChange:changeNr -"/ ] - ]. -"/ skipSignal := nil - ] - ] -! - -doApplyAll - "user wants all changes to be applied" - - self withCursor:(Cursor execute) do:[ - self clearCodeView. - skipSignal isNil ifTrue:[skipSignal := Signal new]. -"/ Object abortSignal catch:[ - 1 to:(changePositions size) do:[:changeNr | + changeNr to:(changePositions size) do:[:changeNr | changeListView selection:changeNr. self applyChange:changeNr -"/ ] - ]. -"/ skipSignal := nil - ] -! - -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 silentDeleteChangesFor:classNameToDelete - from:changeNr - to:(changePositions size). - self setChangeList. "/changeListView setContents:changeChunks. - self autoSelectOrEnd:changeNr - ] + ]. ] ] ! @@ -1160,49 +1241,12 @@ ] ! -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 silentDeleteChangesFor:classNameToDelete - from:1 - to:(changePositions size). - self setChangeList. "/changeListView setContents:changeChunks. - self autoSelectOrEnd:changeNr - ] - ] - ] -! - -doWriteBack - "write back the list onto the changes file" - - anyChanges ifTrue:[ - self writeBackChanges. - realized ifTrue:[ - self readChangesFileInBackground:false. - realized ifTrue:[ - self setChangeList - ] - ] - ] -! - 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 snapshotProto str snapshotPrefix snapshotNameIndex fileName| + |aStream searchIndex anyMore deleteSet index + str snapshotProto snapshotPrefix snapshotNameIndex fileName| aStream := FileStream readonlyFileNamed:changeFileName. aStream isNil ifTrue:[^ self]. @@ -1218,6 +1262,10 @@ snapshotNameIndex := snapshotProto findString:'foo'. self withCursor:(Cursor execute) do:[ + |numChanges classes selectors types excla sawExcla + changeNr chunk aParseTree parseTreeChunk + thisClass thisSelector codeChunk codeParser| + numChanges := changePositions size. classes := Array new:numChanges. selectors := Array new:numChanges. @@ -1314,13 +1362,16 @@ "finally delete what has been found" (deleteSet size > 0) ifTrue:[ - changeListView selection:nil. + changeListView deselect. index := deleteSet size. [index > 0] whileTrue:[ self silentDeleteChange:(deleteSet at:index). index := index - 1 ]. self setChangeList. + " + scroll back a bit, if we are left way behind the list + " changeListView firstLineShown > changePositions size ifTrue:[ changeListView makeLineVisible:changePositions size ]. @@ -1329,12 +1380,16 @@ ] ! -doUpdate - "reread the changes-file" +doApplyAll + "user wants all changes to be applied" - self readChangesFileInBackground:true. - realized ifTrue:[ - self setChangeList + self withCursor:(Cursor execute) do:[ + self clearCodeView. + skipSignal isNil ifTrue:[skipSignal := Signal new]. + 1 to:(changePositions size) do:[:changeNr | + changeListView selection:changeNr. + self applyChange:changeNr + ]. ] ! @@ -1350,6 +1405,133 @@ self compareChange:changeNr ] ] +! + +doDeleteClassRest + "delete rest of changes with same class as currently selected change" + + |changeNr| + + changeNr := changeListView selection. + changeNr notNil ifTrue:[ + self withCursor:(Cursor execute) do:[ + | classNameToDelete | + + classNameToDelete := self classNameOfChange:changeNr. + classNameToDelete notNil ifTrue:[ + changeListView selection:nil. + self silentDeleteChangesFor:classNameToDelete + from:changeNr + to:(changePositions size). + self setChangeList. + self autoSelectOrEnd:changeNr + ] + ] + ] +! + +doWriteBack + "write back the list onto the changes file" + + anyChanges ifTrue:[ + self writeBackChanges. + realized ifTrue:[ + self readChangesFileInBackground:false. + realized ifTrue:[ + self setChangeList + ] + ] + ] +! + +doDeleteClassAll + "delete all changes with same class as currently selected change" + + |changeNr| + + changeNr := changeListView selection. + changeNr notNil ifTrue:[ + self withCursor:(Cursor execute) do:[ + | classNameToDelete | + + classNameToDelete := self classNameOfChange:changeNr. + classNameToDelete notNil ifTrue:[ + changeListView selection:nil. + self silentDeleteChangesFor:classNameToDelete + from:1 + to:(changePositions size). + self setChangeList. + self autoSelectOrEnd:changeNr + ] + ] + ] +! + +doApplyClassRest + "user wants all changes for this class from changeNr to be applied" + + |changeNr | + + changeNr := changeListView selection. + changeNr notNil ifTrue:[ + self withCursor:(Cursor execute) do:[ + |thisClassName classNameToApply| + + classNameToApply := self classNameOfChange:changeNr. + classNameToApply notNil ifTrue:[ + self clearCodeView. + skipSignal isNil ifTrue:[skipSignal := Signal new]. + changeNr to:(changePositions size) do:[:changeNr | + thisClassName := self classNameOfChange:changeNr. + thisClassName = classNameToApply ifTrue:[ + changeListView selection:changeNr. + self applyChange:changeNr + ]. + ]. + ] + ] + ] + + +! ! + +!ChangesBrowser methodsFor:'termination'! + +terminate + "window manager wants us to go away" + + |box| + + anyChanges ifTrue:[ + box := OptionBox title:'' numberOfOptions:3. + box title:(resources at:'close ChangesBrowser.\\changefile has not been updated from the modified changelist.\\Update before closing ?') withCRs. + box buttonTitles:(resources array:#('abort' 'don''t update' 'update')). + box actions:(Array with:[^ self] + with:[self destroy] + with:[self writeBackChanges. self destroy] + ). + box showAtPointer. + ] ifFalse:[ + self destroy + ] +! + +destroy + "destroy the receiver; make certain, that boxes are destroyed too" + + ObjectMemory removeDependent:self. + super destroy +! + +saveAndTerminate + "update the changes file and quit. + Dont depend on this being sent, not all window managers + send it; instead, they simply destroy the view." + + anyChanges ifTrue:[ + self writeBackChanges. + ]. + self destroy ! ! !ChangesBrowser methodsFor:'error handling'! @@ -1395,6 +1577,12 @@ ^ false ! +warning:aString position:relPos to:relEndPos + "compiler notifys us of a warning - ignore it" + + ^ self +! + 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 ??). @@ -1432,11 +1620,5 @@ ^ false ]. ^ codeView error:aString position:relPos to:relEndPos -! - -warning:aString position:relPos to:relEndPos - "compiler notifys us of a warning - ignore it" - - ^ self ! !