"
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.
"
'From Smalltalk/X, Version:2.10.4 on 26-feb-1995 at 5:18:24 am'!
StandardSystemView subclass:#ChangesBrowser
instanceVariableNames:'changeListView codeView changeFileName changeChunks
changePositions changeClassNames changeHeaderLines anyChanges
changeNrShown changeNrProcessed skipSignal'
classVariableNames:'CompressSnapshotInfo'
poolDictionaries:''
category:'Interface-Browsers'
!
ChangesBrowser comment:'
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.25 1995-02-28 21:54:57 claus Exp $
'!
!ChangesBrowser class methodsFor:'documentation'!
copyright
"
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.
"
!
version
"
$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.25 1995-02-28 21:54:57 claus Exp $
"
!
documentation
"
this implements a browser for the changes-file.
See the extra document 'doc/misc/cbrowser.doc' for how to use this browser.
written jan 90 by claus
Class variables:
CompressSnapshotInfo if true (the default), snapshot entries
are also compressed in the compress function.
Some users prefer them to be not compressed.
Set it to false for this.
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 way, we get a browser for any upcoming incore changeSets for
free. Also, this will put the chunk analyzation code into Change and
subclasses (where it belongs) and give a better encapsulation and
overall structure. Do not take this as an example for good style ;-)
"
! !
!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 class methodsFor:'behavior'!
autoSelectNext
"returning true here, makes a Delete operation automatically
select the next change"
^ true
! !
!ChangesBrowser class methodsFor:'defaults'!
defaultLabel
^ 'Changes Browser'
! !
!ChangesBrowser methodsFor:'private'!
streamForChange:changeNr
"answer a stream for change"
|aStream|
(changeNr between:1 and:changePositions size) ifFalse:[^ nil].
aStream := FileStream readonlyFileNamed:changeFileName.
aStream isNil ifTrue:[^ nil].
aStream position:(changePositions at:changeNr).
^ aStream
!
autoSelect:changeNr
"select a change"
self class autoSelectNext ifTrue:[
(changeNr <= changePositions size) ifTrue:[
changeListView selection:changeNr.
self changeSelection:changeNr.
^ self
]
].
self clearCodeView.
changeListView selection:nil.
!
clearCodeView
self unselect "changeListView deselect".
codeView contents:nil.
changeNrShown := nil
!
applyChange:changeNr
"fileIn a change"
|aStream upd nm|
aStream := self streamForChange:changeNr.
aStream isNil ifTrue:[^ self].
nm := self classNameOfChange:changeNr.
nm notNil ifTrue:[
|cls|
cls := Smalltalk at:(nm asSymbol) ifAbsent:[].
cls notNil ifTrue:[
cls isLoaded ifFalse:[
cls autoload
]
]
].
changeNrProcessed := changeNr.
upd := Class updateChanges:false.
[
|sig|
(skipSignal notNil) ifTrue:[
sig := skipSignal
] ifFalse:[
sig := Object abortSignal
].
sig catch:[
aStream fileInNextChunkNotifying:self
].
changeNrProcessed := nil.
] valueNowOrOnUnwindDo:[
Class updateChanges:upd.
aStream close
].
!
unselect
"common unselect"
changeListView deselect.
!
setChangeList
"extract type-information from changes and stuff into top selection
view"
changeListView setList:changeHeaderLines expandTabs:false.
"/ changeListView deselect.
!
readChangesFileInBackground:inBackground
"read the changes file, create a list of header-lines (changeChunks)
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 maxLen|
maxLen := 60.
aStream := FileStream readonlyFileNamed:changeFileName.
aStream isNil ifTrue:[^ nil].
self withCursor:(Cursor read) do:[
|tabSpec myProcess myPriority|
tabSpec := TabulatorSpecification new.
tabSpec unit:#inch.
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
NFS-mounted directory; therefore lower my priority ...
"
inBackground ifTrue:[
myProcess := Processor activeProcess.
myPriority := myProcess priority.
myProcess priority:(Processor userBackgroundPriority).
].
[
|excla|
changeChunks := OrderedCollection new.
changeHeaderLines := OrderedCollection new.
changePositions := OrderedCollection new.
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)
"
aStream skipSeparators.
chunkPos := aStream position.
sawExcla := aStream peekFor:excla.
chunkText := aStream nextChunk.
chunkText notNil ifTrue:[
|index headerLine|
"
only first line is saved in changeChunks ...
"
index := chunkText indexOf:(Character cr).
(index ~~ 0) ifTrue:[
chunkText := chunkText copyTo:(index - 1).
"take care for comment changes - must still be a
valid expression for classNameOfChange: to work"
(chunkText endsWith:'comment:''') ifTrue:[
chunkText := chunkText , '...'''
]
].
changeChunks add:chunkText.
changePositions add:chunkPos.
headerLine := nil.
changeDelta := ' '.
sawExcla ifFalse:[
(chunkText startsWith:'''---- snap') ifTrue:[
changeType := ''.
headerLine := chunkText.
changeString := (chunkText contractTo:maxLen).
] ifFalse:[
|p sel cls|
headerLine := chunkText , ' (doIt)'.
"
first, assume doIt - then lets have a more detailed look ...
"
(chunkText startsWith:'''---- file') ifTrue:[
changeType := ''.
] ifFalse:[
changeType := '(doIt)'.
].
changeString := (chunkText contractTo:maxLen).
p := Parser parseExpression:chunkText.
(p notNil
and:[p ~~ #Error
and:[p isMessage]]) ifTrue:[
sel := p selector.
].
(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.
changeClass := (Smalltalk classNamed:cls)
].
sel := (p receiver args at:1) evaluate.
changeType := '(category change)'.
changeString := self contractClass:cls selector:sel to:maxLen.
]
].
(#(#'subclass:'
#'variableSubclass:'
#'variableByteSubclass:'
#'variableWordSubclass:'
#'variableLongSubclass:'
#'variableFloatSubclass:'
#'variableDoubleSubclass:'
) includes:sel) ifTrue:[
changeType := '(class definition)'.
].
].
] ifTrue:[
|done first p sel cls text|
"
method definitions actually consist of
two (or more) chunks; skip next chunk(s)
up to an empty one.
The system only writes one chunk,
and we cannot handle more in this ChangesBrowser ....
"
cls := nil.
p := Parser parseExpression:chunkText.
(p notNil and:[p ~~ #Error]) ifTrue:[
sel := p selector.
(sel == #methodsFor:) 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
].
category := (p args at:1) evaluate.
].
].
done := false.
first := true.
[done] whileFalse:[
text := aStream nextChunk.
text isNil ifTrue:[
done := true
] ifFalse:[
done := text isEmpty
].
done ifFalse:[
first ifFalse:[
Transcript showCr:'only one method per ''methodsFor:'' handled'.
] ifTrue:[
first := false.
"
try to find the selector
"
sel := nil.
cls notNil ifTrue:[
p := Parser
parseMethodSpecification:text
in:nil
ignoreErrors:true
ignoreWarnings:true.
(p notNil and:[p ~~ #Error]) ifTrue:[
sel := p selector.
]
].
sel isNil ifTrue:[
changeString := (chunkText contractTo:maxLen).
changeType := '(change)'.
] ifFalse:[
changeString := self contractClass:cls selector:sel to:maxLen.
changeType := '(method in: ''' , category , ''')'.
].
sel isNil ifTrue:[
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 := '+'.
]
]
]
]
]
].
changeString notNil ifTrue:[
entry := MultiColListEntry new.
entry tabulatorSpecification:tabSpec.
entry colAt:1 put:changeString.
entry colAt:2 put:changeDelta.
entry colAt:3 put:changeType.
changeHeaderLines add:entry
] ifFalse:[
headerLine notNil ifTrue:[
changeHeaderLines add:headerLine
]
]
]
].
changeClassNames := OrderedCollection new grow:(changeChunks size).
aStream close.
anyChanges := false
] valueNowOrOnUnwindDo:[
inBackground ifTrue:[myProcess priority:myPriority].
].
]
!
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).
s size > maxLen ifTrue:[
s := (className contractTo:(maxLen // 2 - 1)) , ' ' , (selector contractTo:maxLen // 2)
]
]
].
^ s
!
silentDeleteChange:changeNr
"delete a change do not update changeListView"
anyChanges := true.
changeChunks removeIndex:changeNr.
changePositions removeIndex:changeNr.
changeClassNames removeIndex:changeNr.
changeHeaderLines removeIndex:changeNr
!
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].
"
get the chunk
"
chunk := changeChunks at:changeNr.
chunk isNil ifTrue:[^ nil]. "mhmh - empty"
"
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.
"
is it a method-change, methodRemove or comment-change ?
"
(#(#'methodsFor:'
#'privateMethodsFor:'
#'protectedMethodsFor:'
#'publicMethodsFor:'
#'removeSelector:'
#'comment:'
#'renameCategory:to:'
#'instanceVariableNames:'
) 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)
or:[('variable*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
].
]
].
"
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
!
autoSelectOrEnd:changeNr
"select the next change or the last"
|last|
last := changePositions size.
changeNr < last ifTrue:[
self autoSelect:changeNr
] ifFalse:[
changeListView selection:last .
self changeSelection:last.
]
!
withSelectedChangeDo:aBlock
"just a helper, check for a selected change and evaluate aBlock
with busy cursor"
|changeNr|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
self withCursor:(Cursor execute) do:[
aBlock value:changeNr
]
]
!
autoSelectLast
"select the last change"
self autoSelect:(changePositions size)
!
compareChange:changeNr
"compare a change with current version"
|aStream chunk sawExcla parseTree thisClass cat oldSource newSource
parser sel oldMethod outcome showDiff d t1 t2|
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:[
"/
"/ compare for tabulator <-> space changes
"/ before showing diff ...
"/
t1 := oldSource asString withTabsExpanded.
t2 := newSource asString withTabsExpanded.
t1 = t2 ifTrue:[
outcome := 'same source (tabs <-> spaces)'
] ifFalse:[
outcome := 'source changed.'.
showDiff := true
]
]
] ifFalse:[
outcome := 'method does not exist.'
]
] ifFalse:[
outcome := 'change unparsable.'
].
(showDiff and:[oldSource notNil and:[newSource notNil]]) ifTrue:[
d := DiffTextView openOn:oldSource and:newSource.
d label:'differences (current left; change right)'.
]
] ifFalse:[
outcome := 'class does not exist.'
]
] ifFalse:[
outcome := 'not comparable.'
]
] ifFalse:[
outcome := 'not comparable.'
]
].
Transcript showCr:outcome.
aStream close.
!
writeBackChanges
"write back the changes file"
|inStream outStream|
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 sawExcla done dir chunk
nChanges "{Class:SmallInteger}" |
excla := inStream class chunkSeparator.
nChanges := changePositions size.
1 to:nChanges 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
]
].
] ifFalse:[
outStream nextChunkPut:chunk.
outStream cr
]
].
outStream close.
inStream close.
dir := FileDirectory currentDirectory.
dir renameFile:changeFileName newName:'changes.bak'.
dir renameFile:'n_changes' newName:changeFileName.
anyChanges := false
]
!
deleteChange:changeNr
"delete a change"
changeListView deselect.
self silentDeleteChange:changeNr.
self setChangeList
!
deleteChangesFrom:start to:stop
"delete a range of changes"
changeListView deselect.
stop to:start by:-1 do:[:changeNr |
self silentDeleteChange:changeNr
].
self setChangeList
!
queryCloseText
"made this a method for easy redefinition in subclasses"
^ 'Quit without updating changeFile ?'
!
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."
|aStream outStream chunk sawExcla separator|
outStream := FileStream oldFileNamed:fileName.
outStream isNil ifTrue:[
outStream isNil ifTrue:[
outStream := FileStream newFileNamed:fileName.
outStream isNil ifTrue:[
self warn:'cannot update file ''%1''' with:fileName.
^ false
]
]
].
outStream setToEnd.
aStream := self streamForChange:changeNr.
aStream isNil ifTrue:[
self warn:'oops cannot read change'.
^ false
].
separator := aStream class chunkSeparator.
sawExcla := aStream peekFor:separator.
sawExcla ifTrue:[
outStream nextPut:separator
].
chunk := aStream nextChunk.
outStream nextChunkPut:chunk.
outStream cr.
sawExcla ifTrue:[
chunk := aStream nextChunk.
outStream nextChunkPut:chunk.
outStream space
].
sawExcla ifTrue:[
outStream nextPut:separator
].
outStream cr.
aStream close.
outStream close.
^ true
!
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'
!
silentDeleteChangesFor: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
]
! !
!ChangesBrowser methodsFor:'user interaction'!
doApply
"user wants a change to be applied"
self withSelectedChangeDo:[:changeNr |
skipSignal := nil.
self applyChange:changeNr.
self autoSelect:(changeNr + 1)
]
!
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.
!
noChangesAllowed
"show a warning that changes cannot be changed"
self warn:'changes are not allowed to be changed'
!
doSaveClass
"user wants changes for some class from current to end to be appended to a file"
self doSaveClassFrom:1
!
doSaveClassAll
"user wants changes for some class from current to end to be appended to a file"
self doSaveClassFrom:1
!
doSaveClassRest
"user wants changes for some class from current to end to be appended to a file"
|changeNr|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
self doSaveClassFrom:changeNr
]
!
doBrowse
"user wants a browser on the class of a change"
|changeNr className cls|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
className := self classNameOfChange:changeNr.
className notNil ifTrue:[
(cls := Smalltalk classNamed:className) notNil ifTrue:[
SystemBrowser browseClass:cls
]
]
]
!
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
]
]
!
saveClass:aClassName from:startNr
"user wants changes from current to end to be appended to a file"
|changeNr fileName|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
fileName := DialogView
requestFileName:'append changes for class to:'
default:''
ok:'append'
abort:'abort'
pattern:'*.chg'.
fileName notNil ifTrue:[
self withCursor:(Cursor write) do:[
startNr to:(changePositions size) do:[:changeNr |
|thisClassName|
thisClassName := self classNameOfChange:changeNr.
thisClassName = aClassName ifTrue:[
changeListView selection:changeNr.
(self appendChange:changeNr toFile:fileName) ifFalse:[
^ self
]
]
]
]
].
]
!
doDelete
"delete currently selected change"
|changeNr|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
self deleteChange:changeNr.
self autoSelectOrEnd:changeNr
]
!
doSaveClassFrom:startNr
"user wants changes from current to end to be appended to a file"
|changeNr classNameToSave|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
classNameToSave := self classNameOfChange:changeNr.
classNameToSave notNil ifTrue:[
self saveClass:classNameToSave from:startNr
]
]
!
doSaveRest
"user wants changes from current to end to be appended to a file"
|changeNr fileName|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
fileName := DialogView
requestFileName:'append changes to:'
default:''
ok:'append'
abort:'abort'
pattern:'*.chg'.
fileName notNil ifTrue:[
self withCursor:(Cursor write) do:[
changeNr to:(changePositions size) do:[:changeNr |
changeListView selection:changeNr.
(self appendChange:changeNr toFile:fileName) ifFalse:[
^ self
]
]
]
].
]
!
doSave
"user wants a change to be appended to a file"
|changeNr fileName|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
fileName := DialogView
requestFileName:'append change to:'
default:''
ok:'append'
abort:'abort'
pattern:'*.chg'.
fileName notNil ifTrue:[
self withCursor:(Cursor write) do:[
self appendChange:changeNr toFile:fileName.
].
self autoSelect:(changeNr + 1)
].
]
!
doUpdate
"reread the changes-file"
self readChangesFileInBackground:true.
realized ifTrue:[
self setChangeList.
]
!
doMakePermanent
"user wants a change to be made permanent
- rewrite the source file where this change has to go"
|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|
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)
]
!
doDeleteRest
"delete all changes from current to the end"
|changeNr|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
self deleteChangesFrom:changeNr to:(changePositions size).
self clearCodeView.
self autoSelectOrEnd:changeNr-1
]
!
doCompress
"compress the change-set; this replaces multiple method-changes by the last
(i.e. the most recent) change"
|aStream searchIndex anyMore deleteSet index
str snapshotProto snapshotPrefix snapshotNameIndex fileName|
aStream := FileStream readonlyFileNamed:changeFileName.
aStream isNil ifTrue:[^ self].
CompressSnapshotInfo == true ifTrue:[
"
get a prototype snapshot record (to be independent of
the actual format ..
"
str := WriteStream on:String new.
Class addChangeRecordForSnapshot:'foo' to:str.
snapshotProto := str contents.
snapshotPrefix := snapshotProto copyTo: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.
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
ignoreErrors:true
ignoreWarnings:true.
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
]
] ifFalse:[
CompressSnapshotInfo == true ifTrue:[
(chunk startsWith:snapshotPrefix) ifTrue:[
str := chunk readStream position:snapshotNameIndex.
fileName := str upTo:(Character space).
"
kludge to allow use of match-check below
"
selectors at:changeNr put:snapshotPrefix.
classes at:changeNr put:fileName.
]
]
]
].
changeNr := changeNr - 1
].
aStream close.
"for all changes, look for another class/selector occurence later
in the list and, if there is one, add change number to the delete set"
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 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
].
self clearCodeView
]
]
!
doApplyRest
"user wants all changes from changeNr to be applied"
self withSelectedChangeDo:[:changeNr |
self clearCodeView.
skipSignal isNil ifTrue:[skipSignal := Signal new].
changeNr to:(changePositions size) do:[:changeNr |
changeListView selection:changeNr.
self applyChange:changeNr
].
self autoSelect:changePositions size.
]
!
doApplyAll
"user wants all changes to be applied"
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
].
self autoSelectLast
]
!
doWriteBack
"write back the list onto the changes file"
anyChanges ifTrue:[
self writeBackChanges.
realized ifTrue:[
self readChangesFileInBackground:false.
realized ifTrue:[
self setChangeList
]
]
]
!
doDeleteClassRest
"delete rest of changes with same class as currently selected change"
self withSelectedChangeDo:[:changeNr |
| classNameToDelete |
classNameToDelete := self classNameOfChange:changeNr.
classNameToDelete notNil ifTrue:[
changeListView selection:nil.
self silentDeleteChangesFor:classNameToDelete
from:changeNr
to:(changePositions size).
self setChangeList.
self autoSelectOrEnd:changeNr
]
]
!
doDeleteClassAll
"delete all changes with same class as currently selected change"
self withSelectedChangeDo:[:changeNr |
| 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"
self withSelectedChangeDo:[:changeNr |
|thisClassName classNameToApply lastChange|
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.
lastChange := changeNr
].
].
self autoSelect:lastChange.
]
]
! !
!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.
changeListView delegate:self.
changeListView model:self; menu:#changeListMenu.
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"
!
focusSequence
^ Array with:changeListView with:codeView
!
realize
super realize.
self readChangesFileInBackground:true.
self setChangeList.
changeListView action:[:lineNr | self changeSelection:lineNr].
!
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
!
changeListMenu
|labels selectors m|
labels := #(
'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').
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
).
m := PopUpMenu
labels:(resources array:labels)
selectors:selectors.
changeListView hasSelection ifFalse:[
#(doApply doApplyClassRest doApplyRest doDelete doDeleteRest doDeleteClassRest
doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent
doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse)
do:[:sel |
m disable:sel
].
].
^ m
! !
!ChangesBrowser methodsFor:'event handling '!
keyPress:key x:x y:y view:view
"this method is reached via delegation from the changeListView"
key == #Delete ifTrue:[
self doDelete.
^ self
].
changeListView keyPress:key x:x y:y
! !
!ChangesBrowser methodsFor:'termination'!
terminate
"window manager wants us to go away"
|box action|
anyChanges ifTrue:[
action := OptionBox
request:(resources at:'changefile has not been updated from the modified changelist.\\Update before closing ?') withCRs
label:'ChangesBrowser'
form:(WarningBox iconBitmap)
buttonLabels:#('abort' 'don''t update' 'update')
values:#(#abort #ignore #save).
action == #abort ifTrue:[^ self].
action == #save ifTrue:[
self writeBackChanges
].
].
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'!
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"
self error:aString position:relPos to:relEndPos.
^ 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 ??).
Show the bad change in the codeView and let codeView hilight the error"
|action|
(changeNrProcessed ~~ changeNrShown) ifTrue:[
self changeSelection:changeNrProcessed
].
(skipSignal notNil) ifTrue:[
codeView highlightingErrorPosition:relPos to:relEndPos do:[
|box|
"
start dialog - make certain cleanup is done
"
action := OptionBox
request:aString
label:'Error'
form:(WarningBox iconBitmap)
buttonLabels:#('abort' 'skip' 'continue')
values:#(#abort #skip #continue).
].
action == #abort ifTrue:[
Object abortSignal raise.
^ false
].
action == #skip ifTrue:[
skipSignal raise.
^ false
].
^ false
].
^ codeView error:aString position:relPos to:relEndPos
! !