"{ Package: 'Programming Tools' }"
"
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
StandardSystemView subclass:#ChangesBrowser
instanceVariableNames:'changeListView codeView changeFileName
changeChunks changePositions
changeClassNames
anyChanges changeNrShown changeNrProcessed
fileBox'
classVariableNames:''
poolDictionaries:''
category:'Interface-Browsers'
!
ChangesBrowser comment:'
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
this class implements a changes browser.
$Header: /cvs/stx/stx/libtool/Attic/CBrowser.st,v 1.11 1994-07-14 13:13:22 claus Exp $
written jan 90 by claus
'!
!ChangesBrowser class methodsFor:'behavior'!
autoSelectNext
"returning true here, makes a Delete operation automatically
select the next change"
^ true
! !
!ChangesBrowser class methodsFor:'instance creation'!
new
"create a new changes browser"
^ super label:'Changes Browser'
icon:(Form fromFile:'CBrowser.xbm' resolution:100)
!
openOn:aFileName
"create c changes browser on a change file"
^ ((self new label:'Changes Browser:', aFileName) changeFileName:aFileName) open
! !
!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.
anyChanges := false.
ObjectMemory addDependent:self. "to get shutdown-update"
!
initializeMiddleButtonMenu
|labels|
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'
'-'
'make change a patch'
'save change in a file'
'update sourcefile from change'
'-'
'writeback changeFile').
changeListView
middleButtonMenu:(PopUpMenu
labels:labels
selectors:#(
doApply
doApplyRest
doApplyAll
nil
doDelete
doDeleteRest
doDeleteClassRest
doDeleteClassAll
nil
doUpdate
doCompress
doCompare
nil
doMakePatch
doSaveChangeInFile
doMakePermanent
nil
doWriteBack)
receiver:self
for:changeListView)
!
realize
super realize.
self readChangesFile.
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:'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"
#(doApply doApplyRest doDelete doDeleteRest doDeleteClassRest
doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent)
do:[:sel |
changeListView middleButtonMenu enable:sel
].
!
disableMenuEntries
"enable all entries refering to a class"
#(doApply doApplyRest doDelete doDeleteRest doDeleteClassRest
doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent)
do:[:sel |
changeListView middleButtonMenu disable:sel
].
!
unselect
"common unselect"
changeListView deselect.
self disableMenuEntries
!
queryCloseText
"made this a method for easy redefinition in subclasses"
^ 'Quit without updating changeFile ?'
!
changeFileName:aFileName
changeFileName := aFileName
!
withCursor:aCursor do:aBlock
"evaluate aBlock while showing another cursor"
|oldListCursor oldCodeViewCursor|
oldListCursor := changeListView cursor.
oldCodeViewCursor := codeView cursor.
changeListView cursor:aCursor.
codeView cursor:aCursor.
aBlock valueNowOrOnUnwindDo:[
changeListView cursor:oldListCursor.
codeView cursor:oldCodeViewCursor
]
!
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].
"
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
!
streamForChange:changeNr
"answer a stream for change"
|aStream|
aStream := FileStream readonlyFileNamed:changeFileName.
aStream isNil ifTrue:[^ nil].
aStream position:(changePositions at:changeNr).
^ aStream
!
clearCodeView
self unselect "changeListView deselect".
codeView contents:nil.
changeNrShown := nil
!
autoSelect:changeNr
self class autoSelectNext ifTrue:[
(changeNr <= changeChunks size) ifTrue:[
changeListView selection:changeNr.
self changeSelection:changeNr.
^ self
]
].
self clearCodeView
!
writeBackChanges
"write back the changes file"
|inStream outStream chunk sawExcla excla done dir|
outStream := FileStream newFileNamed:'n_changes'.
outStream isNil ifTrue:[
self warn:'cannot create temporary file'.
^ self
].
inStream := FileStream readonlyFileNamed:changeFileName.
inStream isNil ifTrue:[^ nil].
self withCursor:(Cursor write) do:[
excla := inStream class chunkSeparator.
1 to:(changeChunks size) do:[:index |
inStream position:(changePositions at:index).
sawExcla := inStream peekFor:excla.
chunk := inStream nextChunk.
sawExcla ifTrue:[
outStream nextPut:excla.
outStream nextChunkPut:chunk.
outStream cr.
"a method-definition chunk - skip followups"
done := false.
[done] whileFalse:[
chunk := inStream nextChunk.
chunk isNil ifTrue:[
done := true
] ifFalse:[
outStream nextChunkPut:chunk.
outStream cr.
done := chunk isEmpty
]
].
0 "compiler kludge"
] ifFalse:[
outStream nextChunkPut:chunk.
outStream cr
]
].
outStream close.
inStream close.
dir := FileDirectory currentDirectory.
dir removeFile:changeFileName.
dir renameFile:'n_changes' newName:changeFileName.
anyChanges := false
]
!
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 (changeChunks)
and a list of chunk-positions (changePositions)"
|aStream index text done sawExcla chunkPos excla|
aStream := FileStream readonlyFileNamed:changeFileName.
aStream isNil ifTrue:[^ nil].
self withCursor:(Cursor read) do:[
changeChunks := OrderedCollection new.
changePositions := OrderedCollection new.
excla := aStream class chunkSeparator.
[aStream atEnd] whileFalse:[
"
get a chunk (separated by excla)
"
aStream skipSeparators.
chunkPos := aStream position.
sawExcla := aStream peekFor:excla.
text := aStream nextChunk.
text notNil ifTrue:[
changePositions add:chunkPos.
"
only first line is saved in changeChunks ...
"
index := text indexOf:(Character cr).
(index ~~ 0) ifTrue:[
text := text copyTo:(index - 1).
"take care for comment changes - must still be a
valid expression for classNameOfChange: to work"
(text endsWith:'comment:''') ifTrue:[
text := text , '...'''
]
].
changeChunks add:text.
"
method definitions actually consist of
two chunks; skip next one.
"
sawExcla ifTrue:[
"a method-definition chunk - skip followups"
done := false.
[done] whileFalse:[
text := aStream nextChunk.
text isNil ifTrue:[
done := true
] ifFalse:[
done := text isEmpty
]
]
]
]
].
changeClassNames := VariableArray new:(changeChunks size).
aStream close.
anyChanges := false
]
!
silentDeleteChange:changeNr
"delete a change do not update changeListView"
anyChanges := true.
changeChunks removeIndex:changeNr.
changePositions removeIndex:changeNr.
changeClassNames removeIndex:changeNr
!
deleteChange:changeNr
"delete a change"
changeListView deselect.
self silentDeleteChange:changeNr.
changeListView setContents:changeChunks
!
deleteChangesFrom:start to:stop
"delete a range of changes"
changeListView deselect.
stop to:start by:-1 do:[:changeNr |
self silentDeleteChange:changeNr
].
changeListView setContents:changeChunks
!
deleteChangesFor:aClassName from:start to:stop
"delete changes for a given class in a range"
|thisClassName index|
index := stop.
[index >= start] whileTrue:[
thisClassName := self classNameOfChange:index.
thisClassName = aClassName ifTrue:[
self silentDeleteChange:index
].
index := index - 1
]
!
applyChange:changeNr
"filein a change"
|aStream chunk sawExcla upd|
aStream := self streamForChange:changeNr.
aStream isNil ifTrue:[^ self].
sawExcla := aStream peekFor:(aStream class chunkSeparator).
chunk := aStream nextChunk.
upd := Class updateChanges:false.
codeView abortAction:[Class updateChanges:upd.
codeView abortAction:nil.
aStream close.
^self].
changeNrProcessed := changeNr.
[
Object abortSignal catch:[
sawExcla ifFalse:[
Compiler evaluate:chunk notifying:self
] ifTrue:[
(Compiler evaluate:chunk notifying:self) fileInFrom:aStream
notifying:self
]
].
changeNrProcessed := nil.
codeView abortAction:nil
] valueNowOrOnUnwindDo:[Class updateChanges:upd].
aStream close
!
compareChange:changeNr
"compare a change with current version"
|aStream chunk sawExcla parseTree thisClass cat oldSource newSource
parser sel oldMethod outcome showDiff|
aStream := self streamForChange:changeNr.
aStream isNil ifTrue:[^ self].
sawExcla := aStream peekFor:(aStream class chunkSeparator).
chunk := aStream nextChunk.
sawExcla ifFalse:[
outcome := 'not comparable ...'
] ifTrue:[
parseTree := Parser parseExpression:chunk.
(parseTree notNil and:[parseTree isMessage]) ifTrue:[
(parseTree selector == #methodsFor:) ifTrue:[
thisClass := (parseTree receiver evaluate).
thisClass isBehavior ifTrue:[
showDiff := false.
cat := parseTree arg1 evaluate.
newSource := aStream nextChunk.
parser := Parser parseMethod:newSource in:thisClass.
(parser notNil and:[parser ~~ #Error]) ifTrue:[
sel := parser selector.
oldMethod := thisClass compiledMethodAt:sel.
oldMethod notNil ifTrue:[
(oldMethod category = cat) ifFalse:[
Transcript showCr:'category changed.'.
].
oldSource := oldMethod source.
(oldSource = newSource) ifTrue:[
outcome := 'same source'
] ifFalse:[
outcome := 'source changed.'.
showDiff := true
]
] ifFalse:[
outcome := 'method does not exist.'
]
] ifFalse:[
outcome := 'change unparsable.'
].
(showDiff and:[oldSource notNil and:[newSource notNil]]) ifTrue:[
DiffTextView openOn:oldSource and:newSource
]
] ifFalse:[
outcome := 'class does not exist.'
]
] ifFalse:[
outcome := 'not comparable.'
]
] ifFalse:[
outcome := 'not comparable.'
]
].
Transcript showCr:outcome.
aStream close.
!
appendChange:changeNr toFile:fileName
"append change to a file"
|aStream outStream chunk sawExcla|
outStream := FileStream oldFileNamed:fileName.
outStream isNil ifTrue:[
outStream isNil ifTrue:[
outStream := FileStream newFileNamed:fileName.
outStream isNil ifTrue:[
self warn:'cannot update file ''', fileName , ''''.
^ self
]
]
].
outStream setToEnd.
aStream := self streamForChange:changeNr.
aStream isNil ifTrue:[^ self].
sawExcla := aStream peekFor:(aStream class chunkSeparator).
sawExcla ifTrue:[
outStream nextPut:$!!
].
chunk := aStream nextChunk.
outStream nextChunkPut:chunk.
outStream cr.
sawExcla ifTrue:[
chunk := aStream nextChunk.
outStream nextChunkPut:chunk.
outStream space
].
sawExcla ifTrue:[
outStream nextPut:$!!
].
outStream cr.
aStream close.
outStream close
!
makeChangeAPatch:changeNr
"append change to patchfile"
self appendChange:changeNr toFile:'patches'
!
makeChangePermanent:changeNr
"rewrite the source file where change changeNr lies"
self notify:'this is not yet implemented'
! !
!ChangesBrowser methodsFor:'error handling'!
correctableError: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 ??).
Show the bad change in the codeView and let codeView hilight the error;
no corrections allowed here therefore return false"
(changeNrProcessed ~~ changeNrShown) ifTrue:[
self changeSelection:changeNrProcessed
].
codeView error:aString position:relPos to:relEndPos.
^ false
!
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 ??).
Show the bad change in the codeView and let codeView hilight the error"
(changeNrProcessed ~~ changeNrShown) ifTrue:[
self changeSelection:changeNrProcessed
].
^ codeView error:aString position:relPos to:relEndPos
!
warning:aString position:relPos to:relEndPos
"compiler notifys us of a warning - ignore it"
^ self
! !
!ChangesBrowser methodsFor:'user interaction'!
noChangesAllowed
"show a warning that changes cannot be changed"
self warn:(resources at:'changes are not allowed to be changed')
!
changeSelection:lineNr
"show a change in the codeView"
|aStream sawExcla chunk|
aStream := self streamForChange:lineNr.
aStream isNil ifTrue:[^ self].
sawExcla := aStream peekFor:(aStream class chunkSeparator).
chunk := aStream nextChunk.
sawExcla ifTrue:[
chunk := aStream nextChunk
].
aStream close.
codeView contents:chunk.
codeView acceptAction:[:theCode | self doApply "noChangesAllowed"].
changeNrShown := lineNr.
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 := YesNoBox new.
yesNoBox title:(resources at:'Warning: this operation cannot be undone').
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)
]
].
yesNoBox showAtPointer
!
doMakePatch
"user wants a change to be made a patch
- copy it over to the patches file"
|changeNr|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
self makeChangeAPatch:changeNr.
self autoSelect:(changeNr + 1)
]
!
doApply
"user wants a change to be applied"
|changeNr|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
self withCursor:(Cursor execute) do:[
self applyChange:changeNr.
self autoSelect:(changeNr + 1)
]
]
!
doApplyAll
"user wants all changes to be applied"
self withCursor:(Cursor execute) do:[
self clearCodeView.
1 to:(changePositions size) do:[:changeNr |
changeListView selection:changeNr.
self applyChange:changeNr
]
]
!
doApplyRest
"user wants all changes from changeNr to be applied"
|changeNr|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
self withCursor:(Cursor execute) do:[
self clearCodeView.
changeNr to:(changePositions size) do:[:changeNr |
changeListView selection:changeNr.
self applyChange:changeNr
]
]
]
!
doDelete
"delete currently selected change"
|changeNr|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
self deleteChange:changeNr.
self autoSelect:changeNr
]
!
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 deleteChangesFor:classNameToDelete
from:changeNr
to:(changeChunks size).
changeListView setContents:changeChunks.
self autoSelect:changeNr
]
]
]
!
doDeleteRest
"delete all changes from current to the end"
|changeNr|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
self deleteChangesFrom:changeNr to:(changeChunks size).
self clearCodeView
]
!
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 deleteChangesFor:classNameToDelete
from:1
to:(changeChunks size).
changeListView contents:changeChunks.
self autoSelect:changeNr
]
]
]
!
doWriteBack
"write back the list onto the changes file"
anyChanges ifTrue:[
self writeBackChanges.
self doUpdate
]
!
doUpdate
"reread the changes-file"
self readChangesFile.
changeListView setContents:changeChunks
!
doCompare
"compare change with current system version
- give a note in transcript"
|changeNr|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
self withCursor:(Cursor execute) do:[
self compareChange:changeNr
]
]
!
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|
aStream := FileStream readonlyFileNamed:changeFileName.
aStream isNil ifTrue:[^ self].
self withCursor:(Cursor execute) do:[
numChanges := changePositions size.
classes := Array new:numChanges.
selectors := Array new:numChanges.
types := Array new:numChanges.
"starting at the end, get the change class and change selector;
collect all in classes / selectors"
changeNr := numChanges.
excla := aStream class chunkSeparator.
[changeNr >= 1] whileTrue:[
aStream position:(changePositions at:changeNr).
sawExcla := aStream peekFor:excla.
chunk := aStream nextChunk.
sawExcla ifTrue:[
"optimize a bit if multiple methods for same category arrive"
(chunk = parseTreeChunk) ifFalse:[
aParseTree := Parser parseExpression:chunk.
parseTreeChunk := chunk
].
(aParseTree notNil
and:[(aParseTree ~~ #Error)
and:[aParseTree isMessage]]) ifTrue:[
(aParseTree selector == #methodsFor:) ifTrue:[
thisClass := (aParseTree receiver evaluate).
codeChunk := aStream nextChunk.
codeParser := Parser parseMethodSpecification:codeChunk
in:thisClass.
codeParser notNil ifTrue:[
selectors at:changeNr put:(codeParser selector).
classes at:changeNr put:thisClass.
types at:changeNr put:#methodsFor
]
]
]
] ifFalse:[
aParseTree := Parser parseExpression:chunk.
parseTreeChunk := chunk.
(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).
types at:changeNr put:#removeSelector
]
]
].
changeNr := changeNr - 1
].
aStream close.
"for all changes, look for another class/selector occurence and
add change number to delete set if found"
deleteSet := OrderedCollection new.
changeNr := 1.
[changeNr < changePositions size] whileTrue:[
thisClass := classes at:changeNr.
thisSelector := selectors at:changeNr.
searchIndex := changeNr.
anyMore := true.
[anyMore] whileTrue:[
searchIndex := classes indexOf:thisClass
startingAt:(searchIndex + 1).
(searchIndex ~~ 0) ifTrue:[
((selectors at:searchIndex) == thisSelector) ifTrue:[
thisClass notNil ifTrue:[
deleteSet add:changeNr.
anyMore := false
]
]
] ifFalse:[
anyMore := false
]
].
changeNr := changeNr + 1
].
"finally delete what has been found"
(deleteSet size > 0) ifTrue:[
changeListView selection:nil.
index := deleteSet size.
[index > 0] whileTrue:[
self silentDeleteChange:(deleteSet at:index).
index := index - 1
].
changeListView setContents:changeChunks.
changeListView firstLineShown > changeChunks size ifTrue:[
changeListView makeLineVisible:changeChunks size
].
self clearCodeView
]
]
! !