# HG changeset patch # User claus # Date 774191602 -7200 # Node ID eea5a71a1e2364900f6520e84bb1e19879f206c4 # Parent 3dd66037a853f41b27f84498c78530ffb5e70b96 *** empty log message *** diff -r 3dd66037a853 -r eea5a71a1e23 CBrowser.st --- a/CBrowser.st Mon Jan 17 14:47:58 1994 +0100 +++ b/CBrowser.st Thu Jul 14 15:13:22 1994 +0200 @@ -1,3 +1,5 @@ +"{ Package: 'Programming Tools' }" + " COPYRIGHT (c) 1990 by Claus Gittinger All Rights Reserved @@ -15,7 +17,7 @@ changeChunks changePositions changeClassNames anyChanges changeNrShown changeNrProcessed - closeBox' + fileBox' classVariableNames:'' poolDictionaries:'' category:'Interface-Browsers' @@ -28,7 +30,7 @@ this class implements a changes browser. -$Header: /cvs/stx/stx/libtool/Attic/CBrowser.st,v 1.10 1994-01-17 13:47:53 claus Exp $ +$Header: /cvs/stx/stx/libtool/Attic/CBrowser.st,v 1.11 1994-07-14 13:13:22 claus Exp $ written jan 90 by claus '! @@ -50,7 +52,7 @@ icon:(Form fromFile:'CBrowser.xbm' resolution:100) ! -startOn:aFileName +openOn:aFileName "create c changes browser on a change file" ^ ((self new label:'Changes Browser:', aFileName) changeFileName:aFileName) open @@ -74,12 +76,12 @@ v origin:(0.0 @ 0.0) corner:(1.0 @ 0.3). changeListView := v scrolledView. - v := ScrollableView for:CodeView in:frame. + v := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:frame. v origin:(0.0 @ 0.3) corner:(1.0 @ 1.0). codeView := v scrolledView. anyChanges := false. - ObjectMemory addDependent:self. + ObjectMemory addDependent:self. "to get shutdown-update" ! initializeMiddleButtonMenu @@ -100,6 +102,7 @@ 'compare with current version' '-' 'make change a patch' + 'save change in a file' 'update sourcefile from change' '-' 'writeback changeFile'). @@ -122,6 +125,7 @@ doCompare nil doMakePatch + doSaveChangeInFile doMakePermanent nil doWriteBack) @@ -132,68 +136,99 @@ realize super realize. self readChangesFile. - changeListView contents:changeChunks. + self setChangeList. changeListView action:[:lineNr | self changeSelection:lineNr]. self disableMenuEntries. ! -destroy - ObjectMemory removeDependent:self. - closeBox notNil ifTrue:[closeBox destroy. closeBox := nil]. - super destroy -! +update:what + |box| -update:what (what == #aboutToExit) ifTrue:[ - "smalltalk wants to shut down this view - - if change list was modified, ask user and save if requested." - + " + 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. - closeBox isNil ifTrue:[closeBox := YesNoBox new]. - closeBox title:(resources at:'ChangesBrowser:\changefile has not been updated from the modified changelist.\\Update before exiting ?') withCRs. - closeBox noText:(resources at:'don''t update'). - closeBox okText:(resources at:'update'). - closeBox yesAction:[self writeBackChanges] noAction:nil. - closeBox showAtPointer + + 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 + ^ self ]. super update:what ! ! +!ChangesBrowser methodsFor:'termination'! + +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 +! + +terminate + "window manager wants us to go away" + + |box| + + anyChanges ifTrue:[ + box := OptionBox title:'' numberOfOptions:3. + box title:(resources at:'ChangesBrowser:\changefile has not been updated from the modified changelist.\\Update before exiting ?') withCRs. + box buttonTitles:(resources array:#('abort' 'dont''t update' 'update')). + box actions:(Array with:[^ self] + with:[self destroy] + with:[self writeBackChanges. self destroy] + ). + box showAtPointer. + ] ifFalse:[ + self 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. + #(doApply doApplyRest doDelete doDeleteRest doDeleteClassRest + doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent) + do:[:sel | + changeListView middleButtonMenu enable:sel + ]. ! 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. + #(doApply doApplyRest doDelete doDeleteRest doDeleteClassRest + doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent) + do:[:sel | + changeListView middleButtonMenu disable:sel + ]. ! unselect @@ -238,35 +273,58 @@ |chunk aParseTree recTree sel name arg1Tree| changeNr notNil ifTrue:[ + " + first look, if not already known + " name := changeClassNames at:changeNr. name notNil ifTrue:[^ name]. + " + get the chunk + " chunk := changeChunks at:changeNr. chunk notNil ifTrue:[ + " + use parser to construct a parseTree + " aParseTree := Parser parseExpression:chunk. - (aParseTree isKindOf:MessageNode) ifTrue:[ + (aParseTree notNil and:[aParseTree isMessage]) ifTrue:[ + " + ask parser for selector + " sel := aParseTree selector. - "a change for a method or a comment-change" - (#(methodsFor: removeSelector: comment:) includes:sel) ifTrue:[ + " + 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 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 + (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 + ] ] - ]. - "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 + ] 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 + ] ] ] ] @@ -355,9 +413,16 @@ ] ! +setChangeList + "extract type-information from changes and stuff into top selection + view" + + changeListView contents:changeChunks. +! + readChangesFile - "read the changes file, create a list of header-lines and - a list of chunk-poritions" + "read the changes file, create a list of header-lines (changeChunks) + and a list of chunk-positions (changePositions)" |aStream index text done sawExcla chunkPos excla| @@ -370,6 +435,9 @@ excla := aStream class chunkSeparator. [aStream atEnd] whileFalse:[ + " + get a chunk (separated by excla) + " aStream skipSeparators. chunkPos := aStream position. sawExcla := aStream peekFor:excla. @@ -377,10 +445,12 @@ text notNil ifTrue:[ changePositions add:chunkPos. - "only first line is saved in changeChunks ..." + " + only first line is saved in changeChunks ... + " index := text indexOf:(Character cr). (index ~~ 0) ifTrue:[ - text := text copyFrom:1 to:(index - 1). + text := text copyTo:(index - 1). "take care for comment changes - must still be a valid expression for classNameOfChange: to work" @@ -391,6 +461,10 @@ ]. changeChunks add:text. + " + method definitions actually consist of + two chunks; skip next one. + " sawExcla ifTrue:[ "a method-definition chunk - skip followups" done := false. @@ -489,71 +563,79 @@ "compare a change with current version" |aStream chunk sawExcla parseTree thisClass cat oldSource newSource - parser sel oldMethod| + parser sel oldMethod outcome showDiff| aStream := self streamForChange:changeNr. aStream isNil ifTrue:[^ self]. + sawExcla := aStream peekFor:(aStream class chunkSeparator). chunk := aStream nextChunk. sawExcla ifFalse:[ - Transcript showCr:'not comparable ...' + outcome := 'not comparable ...' ] ifTrue:[ parseTree := Parser parseExpression:chunk. - (parseTree isKindOf:MessageNode) ifTrue:[ + (parseTree notNil and:[parseTree isMessage]) ifTrue:[ (parseTree selector == #methodsFor:) ifTrue:[ thisClass := (parseTree receiver evaluate). - (thisClass isBehavior "isKindOf:Class") ifTrue:[ + thisClass isBehavior ifTrue:[ + showDiff := false. cat := parseTree arg1 evaluate. newSource := aStream nextChunk. parser := Parser parseMethod:newSource in:thisClass. - parser notNil ifTrue:[ + (parser notNil and:[parser ~~ #Error]) ifTrue:[ sel := parser selector. oldMethod := thisClass compiledMethodAt:sel. oldMethod notNil ifTrue:[ (oldMethod category = cat) ifFalse:[ - Transcript showCr:'category changed.' + Transcript showCr:'category changed.'. ]. oldSource := oldMethod source. (oldSource = newSource) ifTrue:[ - Transcript showCr:'same source' + outcome := 'same source' ] ifFalse:[ - Transcript showCr:'source changed.' + outcome := 'source changed.'. + showDiff := true ] ] ifFalse:[ - Transcript showCr:'method does not exist.' + outcome := 'method does not exist.' ] ] ifFalse:[ - Transcript showCr:'change unparsable.' + outcome := 'change unparsable.' + ]. + (showDiff and:[oldSource notNil and:[newSource notNil]]) ifTrue:[ + DiffTextView openOn:oldSource and:newSource ] ] ifFalse:[ - Transcript showCr:'class does not exist.' + outcome := 'class does not exist.' ] ] ifFalse:[ - Transcript showCr:'not comparable.' + outcome := 'not comparable.' ] ] ifFalse:[ - Transcript showCr:'not comparable.' + outcome := 'not comparable.' ] ]. - aStream close + Transcript showCr:outcome. + aStream close. ! -makeChangeAPatch:changeNr - "copy change to patchfile" +appendChange:changeNr toFile:fileName + "append change to a file" |aStream outStream chunk sawExcla| - outStream := FileStream oldFileNamed:'patches'. + outStream := FileStream oldFileNamed:fileName. outStream isNil ifTrue:[ outStream isNil ifTrue:[ - outStream := FileStream newFileNamed:'patches'. + outStream := FileStream newFileNamed:fileName. outStream isNil ifTrue:[ - self error:'cannot update patches file'. + self warn:'cannot update file ''', fileName , ''''. ^ self ] ] ]. outStream setToEnd. + aStream := self streamForChange:changeNr. aStream isNil ifTrue:[^ self]. sawExcla := aStream peekFor:(aStream class chunkSeparator). @@ -576,8 +658,14 @@ outStream close ! +makeChangeAPatch:changeNr + "append change to patchfile" + + self appendChange:changeNr toFile:'patches' +! + makeChangePermanent:changeNr - "rewrite the source where change changeNr lies" + "rewrite the source file where change changeNr lies" self notify:'this is not yet implemented' ! ! @@ -641,25 +729,46 @@ self enableMenuEntries ! +doSaveChangeInFile + "user wants a change to be appended to a file" + + |changeNr| + + changeNr := changeListView selection. + changeNr notNil ifTrue:[ + fileBox isNil ifTrue:[ + fileBox := FileSelectionBox new. + ]. + fileBox title:'append change to:'. + fileBox okText:'append'. + fileBox abortText:'cancel'. + fileBox action:[:fileName | + self appendChange:changeNr toFile:fileName. + self autoSelect:(changeNr + 1) + ]. + + fileBox pattern:'*.chg'. + fileBox showAtPointer + ] +! + 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 := YesNoBox new. yesNoBox title:(resources at:'Warning: this operation cannot be undone'). - yesNoBox okText:(resources at:'apply'). + yesNoBox okText:(resources at:'continue'). yesNoBox noText:(resources at:'abort'). yesNoBox okAction:[ - changeNr := changeListView selection. - changeNr notNil ifTrue:[ - self makeChangePermanent:changeNr. - self autoSelect:(changeNr + 1) - ] - ]. + changeNr := changeListView selection. + changeNr notNil ifTrue:[ + self makeChangePermanent:changeNr. + self autoSelect:(changeNr + 1) + ] + ]. yesNoBox showAtPointer ! @@ -794,30 +903,6 @@ ] ! -saveAndTerminate - "update the changes file and quit. - Dont depend on this beeing sent, not all window managers - send it; instead, they simply destroy the view." - - anyChanges ifTrue:[ - self writeBackChanges. - ]. - self destroy -! - -terminate - "window manager wants us to go away" - - 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" @@ -833,7 +918,9 @@ changeNr := changeListView selection. changeNr notNil ifTrue:[ - self compareChange:changeNr + self withCursor:(Cursor execute) do:[ + self compareChange:changeNr + ] ] ! @@ -871,7 +958,9 @@ aParseTree := Parser parseExpression:chunk. parseTreeChunk := chunk ]. - (aParseTree isKindOf:MessageNode) ifTrue:[ + (aParseTree notNil + and:[(aParseTree ~~ #Error) + and:[aParseTree isMessage]]) ifTrue:[ (aParseTree selector == #methodsFor:) ifTrue:[ thisClass := (aParseTree receiver evaluate). codeChunk := aStream nextChunk. @@ -887,7 +976,9 @@ ] ifFalse:[ aParseTree := Parser parseExpression:chunk. parseTreeChunk := chunk. - (aParseTree isKindOf:MessageNode) ifTrue:[ + (aParseTree notNil + and:[(aParseTree ~~ #Error) + and:[aParseTree isMessage]]) ifTrue:[ (aParseTree selector == #removeSelector:) ifTrue:[ selectors at:changeNr put:(aParseTree arg1 value ). classes at:changeNr put:(aParseTree receiver evaluate). diff -r 3dd66037a853 -r eea5a71a1e23 ChangesBrowser.st --- a/ChangesBrowser.st Mon Jan 17 14:47:58 1994 +0100 +++ b/ChangesBrowser.st Thu Jul 14 15:13:22 1994 +0200 @@ -1,3 +1,5 @@ +"{ Package: 'Programming Tools' }" + " COPYRIGHT (c) 1990 by Claus Gittinger All Rights Reserved @@ -15,7 +17,7 @@ changeChunks changePositions changeClassNames anyChanges changeNrShown changeNrProcessed - closeBox' + fileBox' classVariableNames:'' poolDictionaries:'' category:'Interface-Browsers' @@ -28,7 +30,7 @@ this class implements a changes browser. -$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.10 1994-01-17 13:47:53 claus Exp $ +$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.11 1994-07-14 13:13:22 claus Exp $ written jan 90 by claus '! @@ -50,7 +52,7 @@ icon:(Form fromFile:'CBrowser.xbm' resolution:100) ! -startOn:aFileName +openOn:aFileName "create c changes browser on a change file" ^ ((self new label:'Changes Browser:', aFileName) changeFileName:aFileName) open @@ -74,12 +76,12 @@ v origin:(0.0 @ 0.0) corner:(1.0 @ 0.3). changeListView := v scrolledView. - v := ScrollableView for:CodeView in:frame. + v := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:frame. v origin:(0.0 @ 0.3) corner:(1.0 @ 1.0). codeView := v scrolledView. anyChanges := false. - ObjectMemory addDependent:self. + ObjectMemory addDependent:self. "to get shutdown-update" ! initializeMiddleButtonMenu @@ -100,6 +102,7 @@ 'compare with current version' '-' 'make change a patch' + 'save change in a file' 'update sourcefile from change' '-' 'writeback changeFile'). @@ -122,6 +125,7 @@ doCompare nil doMakePatch + doSaveChangeInFile doMakePermanent nil doWriteBack) @@ -132,68 +136,99 @@ realize super realize. self readChangesFile. - changeListView contents:changeChunks. + self setChangeList. changeListView action:[:lineNr | self changeSelection:lineNr]. self disableMenuEntries. ! -destroy - ObjectMemory removeDependent:self. - closeBox notNil ifTrue:[closeBox destroy. closeBox := nil]. - super destroy -! +update:what + |box| -update:what (what == #aboutToExit) ifTrue:[ - "smalltalk wants to shut down this view - - if change list was modified, ask user and save if requested." - + " + 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. - closeBox isNil ifTrue:[closeBox := YesNoBox new]. - closeBox title:(resources at:'ChangesBrowser:\changefile has not been updated from the modified changelist.\\Update before exiting ?') withCRs. - closeBox noText:(resources at:'don''t update'). - closeBox okText:(resources at:'update'). - closeBox yesAction:[self writeBackChanges] noAction:nil. - closeBox showAtPointer + + 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 + ^ self ]. super update:what ! ! +!ChangesBrowser methodsFor:'termination'! + +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 +! + +terminate + "window manager wants us to go away" + + |box| + + anyChanges ifTrue:[ + box := OptionBox title:'' numberOfOptions:3. + box title:(resources at:'ChangesBrowser:\changefile has not been updated from the modified changelist.\\Update before exiting ?') withCRs. + box buttonTitles:(resources array:#('abort' 'dont''t update' 'update')). + box actions:(Array with:[^ self] + with:[self destroy] + with:[self writeBackChanges. self destroy] + ). + box showAtPointer. + ] ifFalse:[ + self 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. + #(doApply doApplyRest doDelete doDeleteRest doDeleteClassRest + doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent) + do:[:sel | + changeListView middleButtonMenu enable:sel + ]. ! 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. + #(doApply doApplyRest doDelete doDeleteRest doDeleteClassRest + doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent) + do:[:sel | + changeListView middleButtonMenu disable:sel + ]. ! unselect @@ -238,35 +273,58 @@ |chunk aParseTree recTree sel name arg1Tree| changeNr notNil ifTrue:[ + " + first look, if not already known + " name := changeClassNames at:changeNr. name notNil ifTrue:[^ name]. + " + get the chunk + " chunk := changeChunks at:changeNr. chunk notNil ifTrue:[ + " + use parser to construct a parseTree + " aParseTree := Parser parseExpression:chunk. - (aParseTree isKindOf:MessageNode) ifTrue:[ + (aParseTree notNil and:[aParseTree isMessage]) ifTrue:[ + " + ask parser for selector + " sel := aParseTree selector. - "a change for a method or a comment-change" - (#(methodsFor: removeSelector: comment:) includes:sel) ifTrue:[ + " + 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 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 + (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 + ] ] - ]. - "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 + ] 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 + ] ] ] ] @@ -355,9 +413,16 @@ ] ! +setChangeList + "extract type-information from changes and stuff into top selection + view" + + changeListView contents:changeChunks. +! + readChangesFile - "read the changes file, create a list of header-lines and - a list of chunk-poritions" + "read the changes file, create a list of header-lines (changeChunks) + and a list of chunk-positions (changePositions)" |aStream index text done sawExcla chunkPos excla| @@ -370,6 +435,9 @@ excla := aStream class chunkSeparator. [aStream atEnd] whileFalse:[ + " + get a chunk (separated by excla) + " aStream skipSeparators. chunkPos := aStream position. sawExcla := aStream peekFor:excla. @@ -377,10 +445,12 @@ text notNil ifTrue:[ changePositions add:chunkPos. - "only first line is saved in changeChunks ..." + " + only first line is saved in changeChunks ... + " index := text indexOf:(Character cr). (index ~~ 0) ifTrue:[ - text := text copyFrom:1 to:(index - 1). + text := text copyTo:(index - 1). "take care for comment changes - must still be a valid expression for classNameOfChange: to work" @@ -391,6 +461,10 @@ ]. changeChunks add:text. + " + method definitions actually consist of + two chunks; skip next one. + " sawExcla ifTrue:[ "a method-definition chunk - skip followups" done := false. @@ -489,71 +563,79 @@ "compare a change with current version" |aStream chunk sawExcla parseTree thisClass cat oldSource newSource - parser sel oldMethod| + parser sel oldMethod outcome showDiff| aStream := self streamForChange:changeNr. aStream isNil ifTrue:[^ self]. + sawExcla := aStream peekFor:(aStream class chunkSeparator). chunk := aStream nextChunk. sawExcla ifFalse:[ - Transcript showCr:'not comparable ...' + outcome := 'not comparable ...' ] ifTrue:[ parseTree := Parser parseExpression:chunk. - (parseTree isKindOf:MessageNode) ifTrue:[ + (parseTree notNil and:[parseTree isMessage]) ifTrue:[ (parseTree selector == #methodsFor:) ifTrue:[ thisClass := (parseTree receiver evaluate). - (thisClass isBehavior "isKindOf:Class") ifTrue:[ + thisClass isBehavior ifTrue:[ + showDiff := false. cat := parseTree arg1 evaluate. newSource := aStream nextChunk. parser := Parser parseMethod:newSource in:thisClass. - parser notNil ifTrue:[ + (parser notNil and:[parser ~~ #Error]) ifTrue:[ sel := parser selector. oldMethod := thisClass compiledMethodAt:sel. oldMethod notNil ifTrue:[ (oldMethod category = cat) ifFalse:[ - Transcript showCr:'category changed.' + Transcript showCr:'category changed.'. ]. oldSource := oldMethod source. (oldSource = newSource) ifTrue:[ - Transcript showCr:'same source' + outcome := 'same source' ] ifFalse:[ - Transcript showCr:'source changed.' + outcome := 'source changed.'. + showDiff := true ] ] ifFalse:[ - Transcript showCr:'method does not exist.' + outcome := 'method does not exist.' ] ] ifFalse:[ - Transcript showCr:'change unparsable.' + outcome := 'change unparsable.' + ]. + (showDiff and:[oldSource notNil and:[newSource notNil]]) ifTrue:[ + DiffTextView openOn:oldSource and:newSource ] ] ifFalse:[ - Transcript showCr:'class does not exist.' + outcome := 'class does not exist.' ] ] ifFalse:[ - Transcript showCr:'not comparable.' + outcome := 'not comparable.' ] ] ifFalse:[ - Transcript showCr:'not comparable.' + outcome := 'not comparable.' ] ]. - aStream close + Transcript showCr:outcome. + aStream close. ! -makeChangeAPatch:changeNr - "copy change to patchfile" +appendChange:changeNr toFile:fileName + "append change to a file" |aStream outStream chunk sawExcla| - outStream := FileStream oldFileNamed:'patches'. + outStream := FileStream oldFileNamed:fileName. outStream isNil ifTrue:[ outStream isNil ifTrue:[ - outStream := FileStream newFileNamed:'patches'. + outStream := FileStream newFileNamed:fileName. outStream isNil ifTrue:[ - self error:'cannot update patches file'. + self warn:'cannot update file ''', fileName , ''''. ^ self ] ] ]. outStream setToEnd. + aStream := self streamForChange:changeNr. aStream isNil ifTrue:[^ self]. sawExcla := aStream peekFor:(aStream class chunkSeparator). @@ -576,8 +658,14 @@ outStream close ! +makeChangeAPatch:changeNr + "append change to patchfile" + + self appendChange:changeNr toFile:'patches' +! + makeChangePermanent:changeNr - "rewrite the source where change changeNr lies" + "rewrite the source file where change changeNr lies" self notify:'this is not yet implemented' ! ! @@ -641,25 +729,46 @@ self enableMenuEntries ! +doSaveChangeInFile + "user wants a change to be appended to a file" + + |changeNr| + + changeNr := changeListView selection. + changeNr notNil ifTrue:[ + fileBox isNil ifTrue:[ + fileBox := FileSelectionBox new. + ]. + fileBox title:'append change to:'. + fileBox okText:'append'. + fileBox abortText:'cancel'. + fileBox action:[:fileName | + self appendChange:changeNr toFile:fileName. + self autoSelect:(changeNr + 1) + ]. + + fileBox pattern:'*.chg'. + fileBox showAtPointer + ] +! + 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 := YesNoBox new. yesNoBox title:(resources at:'Warning: this operation cannot be undone'). - yesNoBox okText:(resources at:'apply'). + yesNoBox okText:(resources at:'continue'). yesNoBox noText:(resources at:'abort'). yesNoBox okAction:[ - changeNr := changeListView selection. - changeNr notNil ifTrue:[ - self makeChangePermanent:changeNr. - self autoSelect:(changeNr + 1) - ] - ]. + changeNr := changeListView selection. + changeNr notNil ifTrue:[ + self makeChangePermanent:changeNr. + self autoSelect:(changeNr + 1) + ] + ]. yesNoBox showAtPointer ! @@ -794,30 +903,6 @@ ] ! -saveAndTerminate - "update the changes file and quit. - Dont depend on this beeing sent, not all window managers - send it; instead, they simply destroy the view." - - anyChanges ifTrue:[ - self writeBackChanges. - ]. - self destroy -! - -terminate - "window manager wants us to go away" - - 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" @@ -833,7 +918,9 @@ changeNr := changeListView selection. changeNr notNil ifTrue:[ - self compareChange:changeNr + self withCursor:(Cursor execute) do:[ + self compareChange:changeNr + ] ] ! @@ -871,7 +958,9 @@ aParseTree := Parser parseExpression:chunk. parseTreeChunk := chunk ]. - (aParseTree isKindOf:MessageNode) ifTrue:[ + (aParseTree notNil + and:[(aParseTree ~~ #Error) + and:[aParseTree isMessage]]) ifTrue:[ (aParseTree selector == #methodsFor:) ifTrue:[ thisClass := (aParseTree receiver evaluate). codeChunk := aStream nextChunk. @@ -887,7 +976,9 @@ ] ifFalse:[ aParseTree := Parser parseExpression:chunk. parseTreeChunk := chunk. - (aParseTree isKindOf:MessageNode) ifTrue:[ + (aParseTree notNil + and:[(aParseTree ~~ #Error) + and:[aParseTree isMessage]]) ifTrue:[ (aParseTree selector == #removeSelector:) ifTrue:[ selectors at:changeNr put:(aParseTree arg1 value ). classes at:changeNr put:(aParseTree receiver evaluate).