"
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 changeHeaderLines
changeIsFollowupMethodChange anyChanges changeNrShown
changeNrProcessed skipSignal compareChanges compareCheckBox
changeFileSize changeFileTimestamp checkBlock changeTimeStamps
tabSpec autoUpdate editingClassSource'
classVariableNames:'CompressSnapshotInfo'
poolDictionaries:''
category:'Interface-Browsers'
!
!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.
"
!
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 originally 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 ;-)
[author:]
Claus Gittinger
[start with:]
ChangesBrowser open
"
! !
!ChangesBrowser class methodsFor:'instance creation'!
new
"create a new changes browser"
^ super label:'Changes Browser'
icon:(self defaultIcon)
"Modified: 19.4.1996 / 16:30:45 / cg"
!
openOn:aFileName
"create c changes browser on a change file"
^ ((self new label:'Changes Browser: ', aFileName)
changeFileName:aFileName) open
"Modified: 19.4.1996 / 16:31:16 / cg"
! !
!ChangesBrowser class methodsFor:'behavior'!
autoSelectNext
"returning true here, makes a Delete operation automatically
select the next change"
^ true
! !
!ChangesBrowser class methodsFor:'defaults'!
defaultIcon
"return the browsers default window icon"
<resource: #style (#ICON #ICON_FILE)>
|nm i|
(i := DefaultIcon) isNil ifTrue:[
i := self classResources at:'ICON' default:nil.
i isNil ifTrue:[
nm := ClassResources at:'ICON_FILE' default:'CBrowser.xbm'.
i := Image fromFile:nm resolution:100.
i isNil ifTrue:[
i := Image fromFile:('bitmaps/' , nm) resolution:100.
i isNil ifTrue:[
i := StandardSystemView defaultIcon
]
]
].
i notNil ifTrue:[
DefaultIcon := i := i on:Display
]
].
^ i
"Modified: 19.3.1997 / 20:48:34 / ca"
"Modified: 18.4.1997 / 15:16:24 / cg"
!
defaultLabel
^ 'Changes Browser'
! !
!ChangesBrowser methodsFor:'compiler interface'!
wantChangeLog
"sent by the compiler to ask if a changeLog entry should
be written. Return false here."
^ false
! !
!ChangesBrowser methodsFor:'error handling'!
correctableError:aString position:relPos to:relEndPos from:aCompiler
"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 from:aCompiler.
^ false
!
error:aString position:relPos to:relEndPos from:aCompiler
"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:#('cancel' 'skip' 'continue')
values:#(#abort #skip #continue)
default:#continue.
].
action == #abort ifTrue:[
Object abortSignal raise.
^ false
].
action == #skip ifTrue:[
skipSignal raise.
^ false
].
^ false
].
^ codeView error:aString position:relPos to:relEndPos from:aCompiler
"Modified: 20.2.1996 / 20:47:59 / cg"
!
warning:aString position:relPos to:relEndPos from:aCompiler
"compiler notifys us of a warning - ignore it"
^ self
! !
!ChangesBrowser methodsFor:'event handling '!
handlesKeyPress:key inView:view
"this method is reached via delegation: are we prepared to handle
a keyPress in some other view ?"
<resource: #keyboard (#Delete #BackSpace #Accept #Find #FindPrev #FindNext)>
view == changeListView ifTrue:[
(key == #Delete
or:[key == #BackSpace
or:[key == #Accept
or:[key == #Find
or:[key == #FindPrev
or:[key == #FindNext]]]]]) ifTrue:[^ true].
].
^ false
"Modified: 8.4.1997 / 11:01:42 / cg"
!
keyPress:key x:x y:y view:view
"this method is reached via delegation from the changeListView"
<resource: #keyboard (#Delete #BackSpace #Accept #Find #FindPrev #FindNext)>
(key == #Delete or:[key == #BackSpace]) ifTrue:[
self doDelete.
^ self
].
(key == #Accept) ifTrue:[
self doApply.
^ self
].
(key == #Find) ifTrue:[
self findClass.
^ self
].
(key == #FindPrev) ifTrue:[
self findPreviousForClass.
^ self
].
(key == #FindNext) ifTrue:[
self findNextForClass.
^ self
].
changeListView keyPress:key x:x y:y
"Modified: 8.4.1997 / 11:01:38 / cg"
! !
!ChangesBrowser methodsFor:'help '!
helpTextFor:aComponent
|s|
aComponent == codeView ifTrue:[
s := 'HELP_CODEVIEW'
].
aComponent == changeListView ifTrue:[
s := 'HELP_CHANGELIST'
].
((aComponent == compareCheckBox)
or:[aComponent superView == compareCheckBox]) ifTrue:[
s := 'HELP_CHECK_COMPARE'
].
s notNil ifTrue:[
^ resources string:s
].
^ nil
!
showActivity:someMessage
"some activityNotification to be forwarded to the user;
show it in the windows title area here."
self label:someMessage
"Created: 24.2.1996 / 19:35:42 / cg"
"Modified: 23.4.1996 / 21:39:36 / cg"
! !
!ChangesBrowser methodsFor:'initialize / release'!
changeListMenu
<resource: #keyboard ( #Accept #Delete ) >
|labels selectors shorties m|
labels := #(
'apply change'
'apply changes to end'
'apply changes for class to end'
'apply all changes'
'-'
'delete'
'delete to end'
'delete changes for class to end'
'delete changes for class from begin'
'delete all changes for class'
'-'
'update view'
'compress'
'compare with current version'
'browse'
'-'
'make change a patch').
editingClassSource ifFalse:[
labels := labels , #('fileout & delete changes for class')
].
labels := labels , #(
'-'
'save change in ...'
'save changes to end in ...'
'save changes for class to end in ...'
'save all changes for class in ...'
'-').
editingClassSource ifTrue:[
labels := labels , #('writeback classFile')
] ifFalse:[
labels := labels , #('writeback changeFile')
].
selectors := #(
doApply
doApplyRest
doApplyClassRest
doApplyAll
nil
doDelete
doDeleteRest
doDeleteClassRest
doDeleteClassFromBeginning
doDeleteClassAll
nil
doUpdate
doCompress
doCompare
doBrowse
nil
doMakePatch).
editingClassSource ifFalse:[
selectors := selectors , #(doFileoutAndDeleteClassAll)
].
selectors := selectors , #(
nil
doSave
doSaveRest
doSaveClassRest
doSaveClassAll
nil
doWriteBack
).
shorties := #(
Accept
nil
nil
nil
nil
Delete
nil
nil
nil
nil
nil
nil
nil
nil
nil
nil
nil
nil
nil
nil
nil
nil
nil
nil
nil
).
m := PopUpMenu
labels:(resources array:labels)
selectors:selectors
accelerators:shorties.
"/
"/ disable those that require a selected entry
"/
changeListView hasSelection ifFalse:[
m disableAll:#(doApply doApplyClassRest doApplyRest doDelete doDeleteRest doDeleteClassRest
doDeleteClassFromBeginning
doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent
doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse doFileoutAndDeleteClassAll)
].
"/
"/ disable those that do not make sense with autoUpdate
"/ ('cause this would be overwritten by next update operation)
"/
autoUpdate ifTrue:[
m disableAll:#(doDelete doDeleteRest doDeleteClassRest doDeleteClassAll doCompress
doFileoutAndDeleteClassAll doWriteBack)
].
^ m
"Modified: 6.9.1995 / 17:14:22 / claus"
"Modified: 5.9.1996 / 17:24:17 / cg"
!
compare:aBoolean
"sent from the compare-toggle"
aBoolean ~~ compareChanges ifTrue:[
compareChanges := aBoolean.
compareChanges ifTrue:[
tabSpec positions:#(0 0.15 5 8.5 ).
self doUpdate
] ifFalse:[
"/
"/ set tabs to hide compare-column
"/
tabSpec positions:#(-1 0 5 8.5 ).
changeListView invalidate. "/ clear; redraw.
]
]
"Modified: 29.5.1996 / 16:12:19 / cg"
!
focusSequence
^ Array with:changeListView with:codeView
!
initialize
|panel v upperFrame buttonPanel autoUpdateCheckBox|
super initialize.
changeFileName := ObjectMemory nameForChanges. "/ 'changes'.
compareChanges := false.
autoUpdate := false.
"
checkBlock is executed by the Processor.
We use #pushEvent: to perform the update
in our windowgroups process.
"
checkBlock := [self pushEvent:#checkIfFileHasChanged].
panel := VariableVerticalPanel origin:(0.0 @ 0.0)
corner:(1.0 @ 1.0)
borderWidth:0
in:self.
upperFrame := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.3) in:panel.
v := HVScrollableView for:SelectionInListView miniScrollerH:true in:upperFrame.
v origin:(0.0 @ 0.0) corner:(0.8 @ 1.0).
changeListView := v scrolledView.
changeListView delegate:self.
changeListView menuHolder:self; menuPerformer:self; menuMessage:#changeListMenu.
changeListView doubleClickAction:[:line | self doBrowse].
buttonPanel := VerticalPanelView in:upperFrame.
buttonPanel origin:(0.8 @ 0.0) corner:(1.0 @ 1.0).
buttonPanel verticalLayout:#topSpace; horizontalLayout:#leftSpace.
compareCheckBox := CheckBox new.
compareCheckBox label:(resources string:'compare').
compareCheckBox action:[:val | self compare:val].
buttonPanel addSubView:compareCheckBox.
autoUpdateCheckBox := CheckBox new.
autoUpdateCheckBox label:(resources string:'auto update').
autoUpdateCheckBox action:[:val | self autoUpdate:val].
buttonPanel addSubView:autoUpdateCheckBox.
v := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:panel.
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"
tabSpec := TabulatorSpecification new.
tabSpec unit:#inch.
tabSpec positions:#(-1 0 5 8.5 ).
" +/- cls>>sel type info"
tabSpec align: #(#left #left #left #left).
"Modified: 24.2.1996 / 16:07:51 / cg"
"Modified: 27.3.1997 / 11:07:07 / stefan"
!
realize
super realize.
self readChangesFileInBackground:true.
self setChangeList.
changeListView action:[:lineNr | self changeSelection:lineNr].
Processor addTimedBlock:checkBlock afterSeconds:5.
!
update:what with:aParameter from:changedObject
|box|
(what == #aboutToExit) ifTrue:[
"
smalltalk is about to shut down -
- if change list was modified, ask user and save if requested.
"
anyChanges ifTrue:[
self raiseDeiconified.
box := YesNoBox new.
box title:(resources at:'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.
box destroy
].
^ self
].
super update:what
"Created: 15.6.1996 / 15:26:30 / cg"
"Modified: 7.1.1997 / 23:03:47 / cg"
! !
!ChangesBrowser methodsFor:'private'!
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.
(changeIsFollowupMethodChange at:changeNr) ifTrue:[
sawExcla := true.
chunk := changeChunks at:changeNr
] ifFalse:[
sawExcla := aStream peekFor:separator.
chunk := aStream nextChunk.
].
sawExcla ifTrue:[
outStream nextPut:separator
].
outStream nextChunkPut:chunk; cr.
sawExcla ifTrue:[
chunk := aStream nextChunk.
outStream nextChunkPut:chunk; space
].
sawExcla ifTrue:[
outStream nextPut:separator
].
outStream cr.
aStream close.
outStream close.
^ true
"Modified: 5.9.1996 / 17:28:22 / cg"
!
applyChange:changeNr
"fileIn a change"
|aStream nm applyAction|
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.
applyAction := [
|sig|
(skipSignal notNil) ifTrue:[
sig := skipSignal
] ifFalse:[
sig := Object abortSignal
].
sig catch:[
|reader doItChunk methodsForChunk|
"/ a followup methodsFor: chunk ...
(changeIsFollowupMethodChange at:changeNr) ifTrue:[
methodsForChunk := (changeChunks at:changeNr).
] ifFalse:[
doItChunk := aStream nextChunk. "/ an empty chunk sometimes ...
doItChunk notEmpty ifTrue:[
Compiler evaluate:doItChunk notifying:self.
] ifFalse:[
methodsForChunk := aStream nextChunk. "/ the real one
]
].
methodsForChunk notNil ifTrue:[
reader := Compiler evaluate:methodsForChunk notifying:self.
reader fileInFrom:aStream notifying:self passChunk:false single:true.
]
].
changeNrProcessed := nil.
].
"/
"/ if I am showing the changes file, dont update it
"/
changeFileName = ObjectMemory nameForChanges ifTrue:[
Class withoutUpdatingChangesDo:applyAction
] ifFalse:[
applyAction value
].
aStream close
"Modified: 10.9.1996 / 20:18:46 / cg"
!
autoSelect:changeNr
"select a change"
self class autoSelectNext ifTrue:[
(changeNr <= self numberOfChanges) ifTrue:[
changeListView setSelection:changeNr.
self changeSelection:changeNr.
^ self
]
].
self clearCodeView.
changeListView setSelection:nil.
"Modified: 25.5.1996 / 12:28:21 / cg"
!
autoSelectLast
"select the last change"
self autoSelect:(self numberOfChanges)
!
autoSelectOrEnd:changeNr
"select the next change or the last"
|last|
last := self numberOfChanges.
changeNr < last ifTrue:[
self autoSelect:changeNr
] ifFalse:[
changeListView setSelection:last .
self changeSelection:last.
]
"Modified: 25.5.1996 / 12:26:17 / cg"
!
changeFileName:aFileName
changeFileName := aFileName
!
checkClassIsLoaded:aClass
|cls|
aClass isMeta ifTrue:[
cls := aClass soleInstance
] ifFalse:[
cls := aClass
].
cls isLoaded ifFalse:[
(self confirm:(cls name , ' is an autoloaded class.\I can only compare the methods texts if its loaded first.\\Load the class first ?') withCRs)
ifTrue:[
cls autoload
]
].
^ cls isLoaded
"Created: 12.12.1995 / 14:04:39 / cg"
"Modified: 12.12.1995 / 14:11:05 / cg"
!
checkIfFileHasChanged
|f info |
Processor removeTimedBlock:checkBlock.
f := changeFileName asFilename.
(info := f info) isNil ifTrue:[
self newLabel:'(unaccessable)'
] ifFalse:[
(info modified) > changeFileTimestamp ifTrue:[
self newLabel:'(outdated)'.
autoUpdate ifTrue:[
self doUpdate
]
] ifFalse:[
self newLabel:''
]
].
Processor addTimedBlock:checkBlock afterSeconds:5.
"Created: 8.9.1995 / 19:30:19 / claus"
"Modified: 8.9.1995 / 19:38:18 / claus"
"Modified: 1.11.1996 / 20:22:56 / cg"
!
classNameOfChange:changeNr
"return the classname of a change
(for classChanges (i.e. xxx class), the non-metaClassName (i.e. xxx) is returned)"
|name|
name := self fullClassNameOfChange:changeNr.
name isNil ifTrue:[^ nil].
(name endsWith:' class') ifTrue:[
^ name copyWithoutLast:6
].
^ name
"Modified: 6.12.1995 / 17:06:31 / cg"
!
clearCodeView
self unselect "changeListView deselect".
codeView contents:nil.
changeNrShown := nil
!
compareChange:changeNr
"compare a change with current version"
|aStream chunk sawExcla parseTree thisClass cat oldSource newSource
parser sel oldMethod outcome showDiff d t1 t2 selector isLoaded
method beep|
aStream := self streamForChange:changeNr.
aStream isNil ifTrue:[^ self].
showDiff := false.
(changeIsFollowupMethodChange at:changeNr) ifFalse:[
sawExcla := aStream peekFor:(aStream class chunkSeparator).
chunk := aStream nextChunk.
] ifTrue:[
chunk := (changeChunks at:changeNr).
sawExcla := true.
].
beep := false.
sawExcla ifFalse:[
outcome := 'cannot compare this change\\(i.e. this is not a method change).'.
parseTree := Parser parseExpression:chunk.
(parseTree notNil and:[parseTree isMessage]) ifTrue:[
((selector := parseTree selector) == #removeSelector:) ifTrue:[
thisClass := (parseTree receiver evaluate).
thisClass isBehavior ifTrue:[
(self checkClassIsLoaded:thisClass) ifTrue:[
selector := (parseTree arg1 evaluate).
(thisClass includesSelector:selector) ifTrue:[
outcome := 'change removes the #' , selector , ' method from ' , thisClass name.
] ifFalse:[
outcome := 'change has no effect\\(there is no method for #' , selector , ' in ' , thisClass name , ')'
]
] ifFalse:[
beep := true.
outcome := 'cannot compare this change (compare requires class to be loaded).'.
]
]
].
selector == #category: ifTrue:[
parseTree receiver isMessage ifTrue:[
parseTree receiver selector == #compiledMethodAt: ifTrue:[
(method := parseTree receiver evaluate) isMethod ifTrue:[
method category = parseTree arg1 evaluate ifTrue:[
outcome := 'change has no effect\\(same category)'.
] ifFalse:[
outcome := 'category is different (''' , method category , ''' vs. ''' , parseTree arg1 evaluate , ''')'
]
] ifFalse:[
beep := true.
outcome := 'there is no such method'
]
]
]
]
]
] ifTrue:[
parseTree := Parser parseExpression:chunk.
(parseTree notNil
and:[parseTree ~~ #Error
and:[parseTree isMessage]]) ifTrue:[
(parseTree selector == #methodsFor:) ifTrue:[
thisClass := (parseTree receiver evaluate).
thisClass isBehavior ifTrue:[
(isLoaded := self checkClassIsLoaded:thisClass) ifFalse:[
outcome := 'cannot compare this change\\(compare requires class to be loaded).'.
].
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:[
oldSource isNil ifTrue:[
beep := true.
outcome := 'no source for compare.'
] ifFalse:[
"/
"/ compare for tabulator <-> space changes
"/ before showing diff ...
"/
t1 := oldSource asCollectionOfLines collect:[:s | s withTabsExpanded].
t2 := newSource asCollectionOfLines collect:[:s | s withTabsExpanded].
t1 = t2 ifTrue:[
outcome := 'same source'
] ifFalse:[
outcome := 'source changed.'.
showDiff := true.
"/
"/ check if only historyLine diffs
"/
(HistoryManager notNil
and:[HistoryManager isActive]) ifTrue:[
(HistoryManager withoutHistoryLines:newSource)
=
(HistoryManager withoutHistoryLines:oldSource)
ifTrue:[
outcome := 'same source (history only)'.
showDiff := false.
]
].
]
]
]
] ifFalse:[
isLoaded ifTrue:[
beep := true.
outcome := 'method does not exist.'
]
]
] ifFalse:[
outcome := 'change unparsable.'
].
(showDiff and:[oldSource notNil and:[newSource notNil]]) ifTrue:[
d := DiffTextView
openOn:oldSource label:'current version'
and:newSource label:'changeFile version'.
d label:'method differences'.
]
] ifFalse:[
beep := true.
outcome := 'class does not exist.'
]
] ifFalse:[
beep := true.
outcome := 'not comparable.'
]
] ifFalse:[
beep := true.
outcome := 'not comparable.'
]
].
aStream close.
showDiff ifFalse:[
beep ifTrue:[
self warn:outcome withCRs.
] ifFalse:[
self information:outcome withCRs.
]
"/ Transcript showCR:outcome.
].
"Created: 24.11.1995 / 14:30:46 / cg"
"Modified: 14.10.1996 / 20:08:16 / cg"
!
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
!
deleteChange:changeNr
"delete a change"
self deleteChangesFrom:changeNr to:changeNr
!
deleteChangesFrom:start to:stop
"delete a range of changes"
changeListView setSelection:nil.
stop to:start by:-1 do:[:changeNr |
self silentDeleteInternalChange:changeNr.
changeListView removeIndex:changeNr.
].
"/ changeListView contentsChanged.
"/ changeListView redrawFromLine:start.
"/ self setChangeList
"Modified: 7.3.1997 / 16:31:20 / cg"
!
fullClassNameOfChange:changeNr
"return the full classname of a change
(for classChanges (i.e. xxx class), a string ending in ' class' is returned.
- since parsing ascii methods is slow, keep result cached in
changeClassNames for the next query"
|chunk aParseTree recTree sel name arg1Tree isMeta prevMethodDefNr
words|
changeNr isNil ifTrue:[^ nil].
"
first look, if not already known
"
name := changeClassNames at:changeNr.
name notNil ifTrue:[^ name].
prevMethodDefNr := changeNr.
[changeIsFollowupMethodChange at:prevMethodDefNr] whileTrue:[
prevMethodDefNr := prevMethodDefNr - 1.
].
"
get the chunk
"
chunk := changeChunks at:prevMethodDefNr.
chunk isNil ifTrue:[^ nil]. "mhmh - empty"
(chunk startsWith:'''---') ifTrue:[
words := chunk asCollectionOfWords.
words size > 2 ifTrue:[
(words at:2) = 'checkin' ifTrue:[
name := words at:3.
changeClassNames at:changeNr put:name.
^ name
]
].
].
"/ fix it - otherwise, it cannot be parsed
(chunk endsWith:'primitiveDefinitions:') ifTrue:[
chunk := chunk , ''''''
].
(chunk endsWith:'primitiveFunctions:') ifTrue:[
chunk := chunk , ''''''
].
(chunk endsWith:'primitiveVariables:') ifTrue:[
chunk := chunk , ''''''
].
"
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:'
#'primitiveDefinitions:'
#'primitiveFunctions:'
#'primitiveVariables:'
#'renameCategory:to:'
#'instanceVariableNames:'
) includes:sel) ifTrue:[
"
yes, the className is the receiver
"
(recTree notNil and:[recTree ~~ #Error]) ifTrue:[
isMeta := false.
recTree isUnaryMessage ifTrue:[
(recTree selector ~~ #class) ifTrue:[^ nil].
"id class methodsFor:..."
recTree := recTree receiver.
isMeta := true.
].
recTree isPrimary ifTrue:[
name := recTree name.
isMeta ifTrue:[
name := name , ' class'.
].
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:)
or:[sel == #privacy:]) ifTrue:[
(recTree notNil
and:[recTree ~~ #Error
and:[recTree isMessage
and:[recTree selector == #compiledMethodAt:]]]) ifTrue:[
isMeta := false.
recTree := recTree receiver.
recTree isUnaryMessage ifTrue:[
(recTree selector ~~ #class) ifTrue:[^ nil].
"id class "
recTree := recTree receiver
].
recTree isPrimary ifTrue:[
isMeta ifTrue:[
name := name , ' class'.
].
name := recTree name.
changeClassNames at:changeNr put:name.
^ name
]
]
].
^ nil
"Modified: 14.2.1997 / 19:37:18 / cg"
!
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'
!
newLabel:how
|l|
(changeFileName ~= 'changes') ifTrue:[
l := 'Changes Browser: ', changeFileName
] ifFalse:[
l := 'Changes Browser'
].
l := l , ' ' , how.
self label:l
"Created: 8.9.1995 / 19:32:04 / claus"
"Modified: 8.9.1995 / 19:39:29 / claus"
!
numberOfChanges
^ changePositions size
"Created: 3.12.1995 / 18:15:39 / cg"
!
queryCloseText
"made this a method for easy redefinition in subclasses"
^ 'Quit without updating changeFile ?'
!
readChangesFile
"read the changes file, create a list of header-lines (changeChunks)
and a list of chunk-positions (changePositions)"
^ self readChangesFileInBackground:false
!
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 delta (only if comparing)
'+' -> new method (w.r.t. current state)
'-' -> removed method (w.r.t. current state)
'?' -> class does not exist currently
'=' -> change is same as current methods source
2 class/selector
3 type of change
doit
method
category change
4 timestamp
since comparing slows down startup time, it is now disabled by
default and can be enabled via a toggle."
|aStream maxLen i f|
editingClassSource := false.
maxLen := 60.
f := changeFileName asFilename.
aStream := f readStream.
aStream isNil ifTrue:[^ nil].
self newLabel:'updating ...'.
i := f info.
changeFileSize := i size.
changeFileTimestamp := i modified.
self withReadCursorDo:[
|myProcess myPriority|
"
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 timeStampInfo|
changeChunks := OrderedCollection new.
changeHeaderLines := OrderedCollection new.
changePositions := OrderedCollection new.
changeTimeStamps := OrderedCollection new.
changeIsFollowupMethodChange := OrderedCollection new.
excla := aStream class chunkSeparator.
[aStream atEnd] whileFalse:[
|entry changeDelta changeString changeType
line s l changeClass sawExcla category
chunkText chunkPos sel|
"
get a chunk (separated by excla)
"
aStream skipSeparators.
chunkPos := aStream position.
sawExcla := aStream peekFor:excla.
chunkText := aStream nextChunk.
chunkText notNil ifTrue:[
|index headerLine cls|
(chunkText startsWith:'''---- timestamp ') ifTrue:[
timeStampInfo := (chunkText copyFrom:16 to:(chunkText size - 6)) withoutSpaces.
] ifFalse:[
"
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 , '...'''
].
(chunkText endsWith:'primitiveDefinitions:''') ifTrue:[
sel := 'primitiveDefinitions:'.
chunkText := chunkText copyWithoutLast:1
].
(chunkText endsWith:'primitiveVariables:''') ifTrue:[
sel := 'primitiveVariables:'.
chunkText := chunkText copyWithoutLast:1
].
(chunkText endsWith:'primitiveFunctions:''') ifTrue:[
sel := 'primitiveFunctions:'.
chunkText := chunkText copyWithoutLast:1
].
].
changeChunks add:chunkText.
changePositions add:chunkPos.
changeTimeStamps add:timeStampInfo.
changeIsFollowupMethodChange add:false.
headerLine := nil.
changeDelta := ' '.
sawExcla ifFalse:[
(chunkText startsWith:'''---- snap') ifTrue:[
changeType := ''.
headerLine := chunkText.
changeString := (chunkText contractTo:maxLen).
timeStampInfo := nil.
] ifFalse:[
|p cls|
headerLine := chunkText , ' (doIt)'.
"
first, assume doIt - then lets have a more detailed look ...
"
((chunkText startsWith:'''---- file')
or:[(chunkText startsWith:'''---- check')]) ifTrue:[
changeType := ''.
timeStampInfo := nil.
] ifFalse:[
changeType := '(doIt)'.
].
changeString := (chunkText contractTo:maxLen).
p := Parser parseExpression:chunkText inNameSpace:Smalltalk.
(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.
compareChanges ifTrue:[
(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.
].
(p ~~ #Error
and:[p isMessage
and:[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 == #category:) ifTrue:[
sel := (p receiver args at:1) evaluate.
changeType := '(category change)'.
changeString := self contractClass:cls selector:sel to:maxLen.
].
(sel == #privacy:) ifTrue:[
sel := (p receiver args at:1) evaluate.
changeType := '(privacy change)'.
changeString := self contractClass:cls selector:sel to:maxLen.
].
].
(#(#'subclass:'
#'variableSubclass:'
#'variableByteSubclass:'
#'variableWordSubclass:'
#'variableLongSubclass:'
#'variableFloatSubclass:'
#'variableDoubleSubclass:'
#'primitiveDefinitions:'
#'primitiveFunctions:'
#'primitiveVariables:'
) includes:sel) ifTrue:[
changeType := '(class definition)'.
].
]
] ifTrue:[ "sawExcla"
|done first p className cls text methodPos|
"
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 ....
"
className := nil.
p := Parser parseExpression:chunkText inNameSpace:Smalltalk.
(p notNil and:[p ~~ #Error]) ifTrue:[
sel := p selector.
(sel == #methodsFor:) ifTrue:[
p receiver isUnaryMessage ifTrue:[
className := p receiver receiver name.
changeClass := (Smalltalk classNamed:className) class.
className := className , ' class'.
] ifFalse:[
className := p receiver name.
changeClass := Smalltalk classNamed:className
].
category := (p args at:1) evaluate.
].
].
done := false.
first := true.
[done] whileFalse:[
changeDelta := ' '.
methodPos := aStream position.
text := aStream nextChunk.
text isNil ifTrue:[
done := true
] ifFalse:[
done := text isEmpty
].
done ifFalse:[
first ifFalse:[
changeChunks add:chunkText.
changePositions add:methodPos.
changeTimeStamps add:timeStampInfo.
changeIsFollowupMethodChange add:true.
editingClassSource := true.
].
first := false.
"
try to find the selector
"
sel := nil.
className 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)'.
headerLine := chunkText , ' (change)'.
] ifFalse:[
changeString := self contractClass:className selector:sel to:maxLen.
changeType := '(method in: ''' , category , ''')'.
headerLine := className , ' ' , sel , ' ' , '(change category: ''' , category , ''')'.
].
compareChanges ifTrue:[
changeClass isNil ifFalse:[
changeClass isMeta ifTrue:[
cls := changeClass soleInstance
] ifFalse:[
cls := changeClass
].
].
(changeClass isNil or:[cls isLoaded not]) ifTrue:[
changeDelta := '?'
] ifFalse:[
(changeClass implements:sel asSymbol) ifFalse:[
changeDelta := '+'.
] ifTrue:[
|m currentText t1 t2|
m := changeClass compiledMethodAt:sel asSymbol.
currentText := m source.
currentText notNil ifTrue:[
text asString = currentText asString ifTrue:[
changeDelta := '='
] ifFalse:[
t1 := currentText asCollectionOfLines collect:[:s | s withTabsExpanded].
t2 := text asCollectionOfLines collect:[:s | s withTabsExpanded].
t1 = t2 ifTrue:[
changeDelta := '='
]
]
]
]
]
].
entry := MultiColListEntry new.
entry tabulatorSpecification:tabSpec.
entry colAt:1 put:changeDelta.
entry colAt:2 put:changeString.
entry colAt:3 put:changeType.
timeStampInfo notNil ifTrue:[
entry colAt:4 put:timeStampInfo.
].
changeHeaderLines add:entry
].
changeString := nil.
headerLine := nil.
]
].
changeString notNil ifTrue:[
entry := MultiColListEntry new.
entry tabulatorSpecification:tabSpec.
entry colAt:1 put:changeDelta.
entry colAt:2 put:changeString.
entry colAt:3 put:changeType.
timeStampInfo notNil ifTrue:[
entry colAt:4 put:timeStampInfo.
].
changeHeaderLines add:entry
] ifFalse:[
headerLine notNil ifTrue:[
changeHeaderLines add:headerLine
]
]
]
]
].
changeClassNames := OrderedCollection new grow:(changeChunks size).
anyChanges := false
] valueNowOrOnUnwindDo:[
aStream close.
inBackground ifTrue:[myProcess priority:myPriority].
].
].
self checkIfFileHasChanged
"Modified: 27.8.1995 / 23:06:55 / claus"
"Modified: 24.6.1997 / 16:44:57 / cg"
!
selectorOfMethodChange:changeNr
"return a method-changes selector, or nil if its not a methodChange"
|source parser sel|
source := self sourceOfMethodChange:changeNr.
source isNil ifTrue:[^ nil].
parser := Parser
parseMethod:source
in:nil
ignoreErrors:true
ignoreWarnings:true.
(parser notNil and:[parser ~~ #Error]) ifTrue:[
sel := parser selector.
].
^ sel
"Created: 24.11.1995 / 14:30:46 / cg"
"Modified: 5.9.1996 / 17:12:50 / cg"
!
setChangeList
"extract type-information from changes and stuff into top selection
view"
changeListView setList:changeHeaderLines expandTabs:false.
"/ changeListView deselect.
!
silentDeleteChange:changeNr
"delete a change do not update changeListView"
anyChanges := true.
changeChunks removeIndex:changeNr.
changePositions removeIndex:changeNr.
changeClassNames removeIndex:changeNr.
changeHeaderLines removeIndex:changeNr.
changeTimeStamps removeIndex:changeNr
"Modified: 18.11.1995 / 17:08:44 / cg"
!
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
]
!
silentDeleteInternalChange:changeNr
"delete a change do not update changeListView"
anyChanges := true.
changeChunks removeIndex:changeNr.
changePositions removeIndex:changeNr.
changeClassNames removeIndex:changeNr.
changeTimeStamps removeIndex:changeNr
"Modified: 18.11.1995 / 17:08:44 / cg"
"Created: 7.3.1997 / 16:28:32 / cg"
!
sourceOfMethodChange:changeNr
"return a method-changes source code, or nil if its not a methodChange."
|aStream chunk sawExcla parseTree sourceChunk|
aStream := self streamForChange:changeNr.
aStream isNil ifTrue:[^ nil].
(changeIsFollowupMethodChange at:changeNr) ifFalse:[
sawExcla := aStream peekFor:(aStream class chunkSeparator).
chunk := aStream nextChunk.
] ifTrue:[
chunk := (changeChunks at:changeNr).
sawExcla := true.
].
sawExcla ifTrue:[
parseTree := Parser parseExpression:chunk.
(parseTree notNil and:[parseTree isMessage]) ifTrue:[
(parseTree selector == #methodsFor:) ifTrue:[
sourceChunk := aStream nextChunk.
]
].
].
aStream close.
^ sourceChunk
"Modified: 5.9.1996 / 17:08:33 / cg"
"Created: 5.9.1996 / 17:11:32 / cg"
!
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
!
unselect
"common unselect"
changeListView setSelection:nil.
"Modified: 25.5.1996 / 13:02:49 / cg"
!
withSelectedChangeDo:aBlock
"just a helper, check for a selected change and evaluate aBlock
with busy cursor"
|changeNr|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
self withExecuteCursorDo:[
aBlock value:changeNr
]
]
"Modified: 14.12.1995 / 20:58:45 / cg"
!
writeBackChanges
"write back the changes file. To avoid problems when the disk is full
or a crash occurs while writing (well, or someone kills us),
first write the stuff to a new temporary file. If this works ok,
rename the old change-file to a .bak file and finally rename the
tempfile back to the change-file.
That way, if anything happens, either the original file is left unchanged,
or we have at least a backup of the previous change file."
|inStream outStream tempfile stamp|
editingClassSource ifTrue:[
(self confirm:'You are editing a classes sourceFile (not a changeFile) !!\\Are you certain, you want to overwrite it ?' withCRs)
ifFalse:[
^ false
]
].
tempfile := Filename newTemporaryIn:nil.
tempfile exists ifTrue:[tempfile remove].
outStream := tempfile writeStream.
outStream isNil ifTrue:[
self warn:'cannot create temporary file in current directory.'.
^ false
].
inStream := FileStream readonlyFileNamed:changeFileName.
inStream isNil ifTrue:[^ false].
self withCursor:(Cursor write) do:[
|excla sawExcla done chunk
nChanges "{Class:SmallInteger}" |
excla := inStream class chunkSeparator.
nChanges := self numberOfChanges.
1 to:nChanges do:[:index |
inStream position:(changePositions at:index).
sawExcla := inStream peekFor:excla.
chunk := inStream nextChunk.
(stamp := changeTimeStamps at:index) notNil ifTrue:[
outStream nextPutAll:'''---- timestamp ' , stamp , ' ----'''.
outStream nextPut:excla; cr.
].
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.
changeFileName asFilename renameTo:(changeFileName , '.bak').
tempfile renameTo:changeFileName.
anyChanges := false
].
^ true
"Modified: 5.9.1996 / 17:20:26 / cg"
"Modified: 2.12.1996 / 22:29:15 / stefan"
! !
!ChangesBrowser methodsFor:'termination'!
destroy
"destroy the receiver; make certain, that boxes are destroyed too"
Processor removeTimedBlock:checkBlock.
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
!
terminate
"window manager wants us to go away"
|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:(resources array:#('cancel' 'don''t update' 'update'))
values:#(#abort #ignore #save)
default:#save.
action == #abort ifTrue:[^ self].
action == #save ifTrue:[
self writeBackChanges
].
].
self destroy
"Modified: 20.2.1996 / 20:48:06 / cg"
! !
!ChangesBrowser methodsFor:'user interaction'!
autoUpdate:aBoolean
autoUpdate := aBoolean
"Created: 3.12.1995 / 14:14:24 / cg"
"Modified: 3.12.1995 / 14:20:45 / cg"
!
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.
!
doApply
"user wants a change to be applied"
self withSelectedChangeDo:[:changeNr |
skipSignal := nil.
self applyChange:changeNr.
self autoSelect:(changeNr + 1)
]
!
doApplyAll
"user wants all changes to be applied"
self withExecuteCursorDo:[
|lastNr "{ Class: SmallInteger }" |
self clearCodeView.
skipSignal isNil ifTrue:[skipSignal := Signal new].
lastNr := self numberOfChanges.
1 to:lastNr do:[:changeNr |
changeListView setSelection:changeNr.
self applyChange:changeNr
].
self autoSelectLast
]
"Modified: 21.1.1997 / 22:26:30 / cg"
!
doApplyClassRest
"user wants all changes for this class from changeNr to be applied"
self withSelectedChangeDo:[:changeNr |
|thisClassName classNameToApply lastChange
lastNr "{ Class: SmallInteger }" |
classNameToApply := self classNameOfChange:changeNr.
classNameToApply notNil ifTrue:[
self clearCodeView.
skipSignal isNil ifTrue:[skipSignal := Signal new].
lastNr := self numberOfChanges.
changeNr to:lastNr do:[:changeNr |
thisClassName := self classNameOfChange:changeNr.
thisClassName = classNameToApply ifTrue:[
changeListView setSelection:changeNr.
self applyChange:changeNr.
lastChange := changeNr
].
].
self autoSelect:lastChange.
]
]
"Modified: 21.1.1997 / 22:26:04 / cg"
!
doApplyRest
"user wants all changes from changeNr to be applied"
self withSelectedChangeDo:[:changeNr |
|lastNr "{ Class: SmallInteger }" |
self clearCodeView.
skipSignal isNil ifTrue:[skipSignal := Signal new].
lastNr := self numberOfChanges.
changeNr to:lastNr do:[:changeNr |
changeListView setSelection:changeNr.
self applyChange:changeNr
].
self autoSelect:self numberOfChanges.
]
"Modified: 21.1.1997 / 22:25:29 / cg"
!
doBrowse
"user wants a browser on the class of a change"
|changeNr className cls isMeta|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
className := self fullClassNameOfChange:changeNr.
className notNil ifTrue:[
isMeta := false.
(className endsWith:' class') ifTrue:[
className := className copyWithoutLast:6.
isMeta := true.
].
(cls := Smalltalk classNamed:className) notNil ifTrue:[
isMeta ifTrue:[
cls := cls class
].
SystemBrowser
openInClass:cls
selector:(self selectorOfMethodChange:changeNr)
]
]
]
"Created: 24.11.1995 / 23:13:24 / cg"
"Modified: 6.12.1995 / 17:09:26 / cg"
!
doCompare
"compare change with current system version
- give a note in transcript"
|changeNr|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
self withExecuteCursorDo:[
self compareChange:changeNr
]
].
self newLabel:''
"Modified: 24.2.1996 / 19:37:19 / cg"
!
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].
self newLabel:'compressing ...'.
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 withExecuteCursorDo:[
|numChanges classes selectors types excla sawExcla
changeNr chunk aParseTree parseTreeChunk
thisClass thisSelector codeChunk codeParser|
numChanges := self numberOfChanges.
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 and:[codeParser ~~ #Error]) 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 < self numberOfChanges] 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 setSelection:nil.
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 > self numberOfChanges ifTrue:[
changeListView makeLineVisible:self numberOfChanges
].
self clearCodeView
]
].
self newLabel:''.
"Created: 3.12.1995 / 14:29:54 / cg"
"Modified: 25.5.1996 / 13:02:47 / cg"
!
doDelete
"delete currently selected change"
|changeNr|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
self deleteChange:changeNr.
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 setSelection:nil.
self silentDeleteChangesFor:classNameToDelete
from:1
to:(self numberOfChanges).
self setChangeList.
self autoSelectOrEnd:changeNr
]
]
"Created: 13.12.1995 / 16:07:14 / cg"
"Modified: 25.5.1996 / 12:26:31 / cg"
!
doDeleteClassFromBeginning
"delete changes with same class as currently selected change from the beginning
up to the selected change.
Useful to get rid of obsolete changes before a fileout or checkin entry."
self withSelectedChangeDo:[:changeNr |
| classNameToDelete |
classNameToDelete := self classNameOfChange:changeNr.
classNameToDelete notNil ifTrue:[
changeListView setSelection:nil.
self silentDeleteChangesFor:classNameToDelete
from:1
to:changeNr.
self setChangeList.
self autoSelectOrEnd:changeNr
]
]
"Created: 13.12.1995 / 15:41:58 / cg"
"Modified: 25.5.1996 / 12:26:34 / cg"
!
doDeleteClassRest
"delete rest of changes with same class as currently selected change"
self withSelectedChangeDo:[:changeNr |
| classNameToDelete |
classNameToDelete := self classNameOfChange:changeNr.
classNameToDelete notNil ifTrue:[
changeListView setSelection:nil.
self silentDeleteChangesFor:classNameToDelete
from:changeNr
to:(self numberOfChanges).
self setChangeList.
self autoSelectOrEnd:changeNr
]
]
"Modified: 25.5.1996 / 12:26:39 / cg"
!
doDeleteRest
"delete all changes from current to the end"
|changeNr|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
self deleteChangesFrom:changeNr to:(self numberOfChanges).
self clearCodeView.
self autoSelectOrEnd:changeNr-1
]
!
doFileoutAndDeleteClassAll
"first fileOut the selected changes class then delete all changes
for it."
self withSelectedChangeDo:[:changeNr |
| className class |
className := self classNameOfChange:changeNr.
className notNil ifTrue:[
class := Smalltalk classNamed:className.
class notNil ifTrue:[
Class fileOutErrorSignal handle:[:ex |
self warn:('fileout failed: ' , ex errorString).
] do:[
class fileOut.
self doDeleteClassAll
].
].
].
]
"Modified: 6.9.1995 / 17:11:16 / claus"
!
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)
]
!
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.
yesNoBox destroy
"Modified: 7.1.1997 / 23:03:33 / cg"
!
doSave
"user wants a change to be appended to a file"
|changeNr fileName|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
fileName := Dialog
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)
].
]
!
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
!
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
]
]
!
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
]
!
doSaveRest
"user wants changes from current to end to be appended to a file"
|changeNr fileName|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
fileName := Dialog
requestFileName:'append changes to:'
default:''
ok:'append'
abort:'abort'
pattern:'*.chg'.
fileName notNil ifTrue:[
self withCursor:(Cursor write) do:[
changeNr to:(self numberOfChanges) do:[:changeNr |
changeListView setSelection:changeNr.
(self appendChange:changeNr toFile:fileName) ifFalse:[
^ self
]
]
]
].
]
"Modified: 25.5.1996 / 12:26:41 / cg"
!
doUpdate
"reread the changes-file"
self readChangesFileInBackground:true.
realized ifTrue:[
self setChangeList.
]
!
doWriteBack
"write back the list onto the changes file"
anyChanges ifTrue:[
(self writeBackChanges) ifTrue:[
realized ifTrue:[
self readChangesFileInBackground:false.
realized ifTrue:[
self setChangeList
]
]
]
]
"Modified: 5.9.1996 / 17:19:46 / cg"
!
findClass
|nm current savedCursor search|
changeNrShown notNil ifTrue:[
current := self classNameOfChange:changeNrShown.
].
nm := Dialog request:'class to search for:' initialAnswer:current.
changeNrShown isNil ifTrue:[
search := 1.
] ifFalse:[
search := changeNrShown + 1
].
self withCursor:Cursor questionMark do:[
|lastNr cls nr thisClass |
lastNr := self numberOfChanges.
nr := search.
[nr <= lastNr] whileTrue:[
thisClass := self classNameOfChange:nr.
thisClass = nm ifTrue:[
changeListView setSelection:nr.
self changeSelection:nr.
^ self
].
nr := nr + 1.
].
].
self beep.
savedCursor := cursor.
self cursor:(Cursor cross).
Delay waitForMilliseconds:300.
self cursor:savedCursor
"Created: 8.4.1997 / 11:00:16 / cg"
"Modified: 8.4.1997 / 11:00:45 / cg"
"Modified: 18.4.1997 / 12:47:52 / stefan"
!
findNextForClass
|savedCursor|
changeNrShown isNil ifTrue:[^ self].
self withCursor:Cursor questionMark do:[
|lastNr cls nr thisClass |
cls := self classNameOfChange:changeNrShown.
cls isNil ifTrue:[^ self].
lastNr := self numberOfChanges.
nr := changeNrShown + 1.
[nr <= lastNr] whileTrue:[
thisClass := self classNameOfChange:nr.
thisClass = cls ifTrue:[
changeListView setSelection:nr .
self changeSelection:nr.
^ self
].
nr := nr + 1.
].
].
self beep.
savedCursor := cursor.
self cursor:(Cursor cross).
Delay waitForMilliseconds:300.
self cursor:savedCursor
"Created: 21.1.1997 / 22:28:07 / cg"
"Modified: 18.4.1997 / 12:48:18 / stefan"
!
findPreviousForClass
|savedCursor|
changeNrShown isNil ifTrue:[^ self].
self withCursor:Cursor questionMark do:[
|cls nr thisClass |
Object userInterruptSignal handle:[:ex |
self beep.
^ self
] do:[
cls := self classNameOfChange:changeNrShown.
cls isNil ifTrue:[^ self].
nr := changeNrShown - 1.
[nr >= 1] whileTrue:[
thisClass := self classNameOfChange:nr.
thisClass = cls ifTrue:[
changeListView setSelection:nr .
self changeSelection:nr.
^ self
].
nr := nr - 1.
].
]
].
self beep.
savedCursor := cursor.
self cursor:(Cursor cross).
Delay waitForMilliseconds:300.
self cursor:savedCursor
"Modified: 2.4.1997 / 18:17:02 / cg"
"Modified: 18.4.1997 / 12:48:41 / stefan"
!
noChangesAllowed
"show a warning that changes cannot be changed"
self warn:'changes are not allowed to be changed'
!
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 := Dialog
requestFileName:'append changes for class to:'
default:''
ok:'append'
abort:'abort'
pattern:'*.chg'.
fileName notNil ifTrue:[
self withCursor:(Cursor write) do:[
startNr to:(self numberOfChanges) do:[:changeNr |
|thisClassName|
thisClassName := self classNameOfChange:changeNr.
thisClassName = aClassName ifTrue:[
changeListView setSelection:changeNr.
(self appendChange:changeNr toFile:fileName) ifFalse:[
^ self
]
]
]
]
].
]
"Modified: 25.5.1996 / 12:26:44 / cg"
! !
!ChangesBrowser class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.112 1997-06-24 14:51:57 cg Exp $'
! !