--- 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).
--- 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).