--- a/ChangesBrowser.st Tue Nov 01 14:18:24 1994 +0100
+++ b/ChangesBrowser.st Thu Nov 17 15:44:34 1994 +0100
@@ -10,12 +10,12 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.3 on 26-sep-1994 at 1:19:22 pm'!
+'From Smalltalk/X, Version:2.10.4 on 6-nov-1994 at 21:36:13'!
StandardSystemView subclass:#ChangesBrowser
instanceVariableNames:'changeListView codeView changeFileName changeChunks
changePositions changeClassNames changeHeaderLines anyChanges
- changeNrShown changeNrProcessed fileBox skipSignal'
+ changeNrShown changeNrProcessed skipSignal'
classVariableNames:''
poolDictionaries:''
category:'Interface-Browsers'
@@ -25,7 +25,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.18 1994-11-01 13:18:24 claus Exp $
+$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.19 1994-11-17 14:44:05 claus Exp $
'!
!ChangesBrowser class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.18 1994-11-01 13:18:24 claus Exp $
+$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.19 1994-11-17 14:44:05 claus Exp $
"
!
@@ -56,9 +56,22 @@
See the extra document 'doc/misc/cbrowser.doc' for how to use this browser.
written jan 90 by claus
+
+ 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 ways, we get a browser for any upcoming incore changeSets for
+ free.
"
! !
+!ChangesBrowser class methodsFor:'defaults'!
+
+defaultLabel
+ ^ 'Changes Browser'
+! !
+
!ChangesBrowser class methodsFor:'instance creation'!
new
@@ -83,170 +96,47 @@
^ true
! !
-!ChangesBrowser methodsFor:'initialize / release'!
-
-initializeMiddleButtonMenu
- |labels|
+!ChangesBrowser methodsFor:'menu stuff'!
- 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'
- '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').
+disableMenuEntries
+ "enable all entries refering to a selected change"
- changeListView
- middleButtonMenu:(PopUpMenu
- labels:labels
- selectors:#(
- doApply
- doApplyRest
- doApplyAll
- nil
- doDelete
- doDeleteRest
- doDeleteClassRest
- doDeleteClassAll
- nil
- doUpdate
- doCompress
- doCompare
- doBrowse
- nil
- doMakePatch
-"/ doMakePermanent
-"/ nil
- doSave
- doSaveRest
- doSaveClassRest
- doSaveClassAll
- nil
- doWriteBack)
- receiver:self
- for:changeListView)
+ #(doApply doApplyClassRest doApplyRest doDelete doDeleteRest doDeleteClassRest
+ doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent
+ doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse)
+ do:[:sel |
+ changeListView middleButtonMenu disable:sel
+ ].
!
-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.
- codeView readOnly.
-
- anyChanges := false.
- ObjectMemory addDependent:self. "to get shutdown-update"
-!
-
-realize
- super realize.
- self readChangesFileInBackground:true.
- 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.
+enableMenuEntries
+ "enable all entries refering to a selected change"
- 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
+ #(doApply doApplyClassRest doApplyRest
+ doDelete doDeleteRest doDeleteClassRest
+ doDeleteClassAll
+ doCompare doMakePatch doSaveChangeInFile doMakePermanent
+ doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse)
+ do:[:sel |
+ changeListView middleButtonMenu enable:sel
].
- super update:what
-! !
-
-!ChangesBrowser methodsFor:'termination'!
-
-terminate
- "window manager wants us to go away"
-
- |box|
-
- anyChanges ifTrue:[
- box := OptionBox title:'' numberOfOptions:3.
- box title:(resources at:'close ChangesBrowser.\\changefile has not been updated from the modified changelist.\\Update before closing ?') withCRs.
- box buttonTitles:(resources array:#('abort' 'don''t update' 'update')).
- box actions:(Array with:[^ self]
- with:[self destroy]
- with:[self writeBackChanges. self destroy]
- ).
- box showAtPointer.
- ] ifFalse:[
- self destroy
- ]
-!
-
-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
! !
!ChangesBrowser methodsFor:'private'!
+clearCodeView
+ self unselect "changeListView deselect".
+ codeView contents:nil.
+ changeNrShown := nil
+!
+
+unselect
+ "common unselect"
+
+ changeListView deselect.
+ self disableMenuEntries
+!
+
streamForChange:changeNr
"answer a stream for change"
@@ -258,93 +148,83 @@
^ aStream
!
-enableMenuEntries
- "enable all entries refering to a selected change"
+applyChange:changeNr
+ "fileIn a change"
+
+ |aStream upd nm|
- #(doApply doApplyRest doDelete doDeleteRest doDeleteClassRest
- doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent
- doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse)
- do:[:sel |
- changeListView middleButtonMenu enable:sel
- ].
-!
+ aStream := self streamForChange:changeNr.
+ aStream isNil ifTrue:[^ self].
+
+ nm := self classNameOfChange:changeNr.
+ nm notNil ifTrue:[
+ |cls|
-unselect
- "common unselect"
+ cls := Smalltalk at:(nm asSymbol) ifAbsent:[].
+ cls notNil ifTrue:[
+ cls isLoaded ifFalse:[
+ cls autoload
+ ]
+ ]
+ ].
- changeListView deselect.
- self disableMenuEntries
-!
+ changeNrProcessed := changeNr.
-disableMenuEntries
- "enable all entries refering to a selected change"
+ upd := Class updateChanges:false.
+ [
+ |sig|
- #(doApply doApplyRest doDelete doDeleteRest doDeleteClassRest
- doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent
- doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse)
- do:[:sel |
- changeListView middleButtonMenu disable:sel
+ (skipSignal notNil) ifTrue:[
+ sig := skipSignal
+ ] ifFalse:[
+ sig := Object abortSignal
+ ].
+ sig catch:[
+ aStream fileInNextChunkNotifying:self
+ ].
+ changeNrProcessed := nil.
+ ] valueNowOrOnUnwindDo:[
+ Class updateChanges:upd.
+ aStream close
].
!
-clearCodeView
- self unselect "changeListView deselect".
- codeView contents:nil.
- changeNrShown := nil
-!
+setChangeList
+ "extract type-information from changes and stuff into top selection
+ view"
-autoSelect:changeNr
- self class autoSelectNext ifTrue:[
- (changeNr <= changePositions size) ifTrue:[
- self clearCodeView.
- changeListView selection:changeNr.
- self changeSelection:changeNr.
- ^ self
- ]
- ].
- self clearCodeView
+ changeListView setList:changeHeaderLines expandTabs:false.
+ "/ changeListView deselect.
+ self disableMenuEntries
!
-autoSelectOrEnd:changeNr
- |last|
-
- last := changePositions size.
- changeNr < last ifTrue:[
- self autoSelect:changeNr
- ] ifFalse:[
- self clearCodeView.
- changeListView selection:last .
- self changeSelection:last .
- ]
-!
-
-contractClass:className selector:selector to:maxLen
- |s l|
+silentDeleteChange:changeNr
+ "delete a change do not update changeListView"
- 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
+ anyChanges := true.
+ changeChunks removeIndex:changeNr.
+ changePositions removeIndex:changeNr.
+ changeClassNames removeIndex:changeNr.
+ changeHeaderLines removeIndex:changeNr
!
readChangesFileInBackground:inBackground
"read the changes file, create a list of header-lines (changeChunks)
- and a list of chunk-positions (changePositions)"
+ 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 index chunkText headerLine done sawExcla chunkPos excla
- myProcess myPriority p sel cls text first category tabSpec entry
- maxLen|
+ |aStream maxLen|
maxLen := 60.
@@ -352,11 +232,13 @@
aStream isNil ifTrue:[^ nil].
self withCursor:(Cursor read) do:[
+ |tabSpec myProcess myPriority|
+
tabSpec := TabulatorSpecification new.
tabSpec unit:#inch.
- tabSpec positions:#(0 4.5 5.5 ).
- " cls>>sel type info "
- tabSpec align: #(#left #left #left).
+ 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
@@ -367,8 +249,9 @@
myPriority := myProcess priority.
myProcess priority:(Processor userBackgroundPriority).
].
+
[
- |entry changeString changeType line s l|
+ |excla|
changeChunks := OrderedCollection new.
changeHeaderLines := OrderedCollection new.
@@ -376,6 +259,10 @@
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)
"
@@ -384,6 +271,8 @@
sawExcla := aStream peekFor:excla.
chunkText := aStream nextChunk.
chunkText notNil ifTrue:[
+ |index headerLine|
+
"
only first line is saved in changeChunks ...
"
@@ -403,34 +292,70 @@
changeChunks add:chunkText.
changePositions add:chunkPos.
headerLine := nil.
+ changeDelta := ' '.
sawExcla ifFalse:[
- (chunkText startsWith:'''---- snap') ifFalse:[
+ (chunkText startsWith:'''---- snap') ifTrue:[
+ changeType := ''.
+ headerLine := chunkText.
+ changeString := (chunkText contractTo:maxLen).
+ ] ifFalse:[
+ |p sel cls|
+
headerLine := chunkText , ' (doIt)'.
- entry := MultiColListEntry new.
-
+ "
+ first, assume doIt - then lets have a more detailed look ...
+ "
changeType := '(doIt)'.
changeString := (chunkText contractTo:maxLen).
+
p := Parser parseExpression:chunkText.
- (p notNil and:[p ~~ #Error]) ifTrue:[
+ (p notNil
+ and:[p ~~ #Error
+ and:[p isMessage]]) ifTrue:[
sel := p selector.
- (sel == #removeSelector:) ifTrue:[
- p receiver isUnaryMessage ifTrue:[
+ ].
+ (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.
- cls := cls , 'class'
- ] ifFalse:[
- cls := p receiver name
+ changeClass := (Smalltalk classNamed:cls)
].
- sel := (p args at:1) evaluate.
- changeType := '(remove)'.
+ sel := (p receiver args at:1) evaluate.
+ changeType := '(category change)'.
changeString := self contractClass:cls selector:sel to:maxLen.
]
- ].
- ] ifTrue:[
- headerLine := chunkText
+ ]
].
] ifTrue:[
+ |done first p sel cls text|
+
"
method definitions actually consist of
two (or more) chunks; skip next chunk(s)
@@ -446,9 +371,11 @@
(sel == #methodsFor:) ifTrue:[
p receiver isUnaryMessage ifTrue:[
cls := p receiver receiver name.
- cls := cls , 'class'
+ changeClass := (Smalltalk classNamed:cls) class.
+ cls := cls , ' class'.
] ifFalse:[
- cls := p receiver name
+ cls := p receiver name.
+ changeClass := Smalltalk classNamed:cls
].
category := (p args at:1) evaluate.
].
@@ -482,7 +409,6 @@
]
].
- entry := MultiColListEntry new.
sel isNil ifTrue:[
changeString := (chunkText contractTo:maxLen).
changeType := '(change)'.
@@ -494,15 +420,24 @@
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 := '+'.
+ ]
]
]
]
]
].
- entry notNil ifTrue:[
+ changeString notNil ifTrue:[
+ entry := MultiColListEntry new.
entry tabulatorSpecification:tabSpec.
entry colAt:1 put:changeString.
- entry colAt:2 put:changeType.
+ entry colAt:2 put:changeDelta.
+ entry colAt:3 put:changeType.
changeHeaderLines add:entry
] ifFalse:[
headerLine notNil ifTrue:[
@@ -520,76 +455,178 @@
]
!
-queryCloseText
- "made this a method for easy redefinition in subclasses"
+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).
- ^ 'Quit without updating changeFile ?'
+ s size > maxLen ifTrue:[
+ s := (className contractTo:(maxLen // 2 - 1)) , ' ' , (selector contractTo:maxLen // 2)
+ ]
+ ]
+ ].
+ ^ s
+!
+
+autoSelect:changeNr
+ self class autoSelectNext ifTrue:[
+ (changeNr <= changePositions size) ifTrue:[
+ self clearCodeView.
+ changeListView selection:changeNr.
+ self changeSelection:changeNr.
+ ^ self
+ ]
+ ].
+ self clearCodeView
!
-applyChange:changeNr
- "fileIn a change"
+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].
- |aStream upd sig nm cls|
+ "
+ get the chunk
+ "
+ chunk := changeChunks at:changeNr.
+ chunk isNil ifTrue:[^ nil]. "mhmh - empty"
- aStream := self streamForChange:changeNr.
- aStream isNil ifTrue:[^ self].
+ "
+ 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.
- nm := self classNameOfChange:changeNr.
- nm notNil ifTrue:[
- cls := Smalltalk at:(nm asSymbol) ifAbsent:[].
- cls notNil ifTrue:[
- cls isLoaded ifFalse:[
- cls autoload
+ "
+ is it a method-change, methodRemove or comment-change ?
+ "
+ (#(#'methodsFor:'
+ #'privateMethodsFor:'
+ #'protectedMethodsFor:'
+ #'publicMethodsFor:'
+ #'removeSelector:'
+ #'comment:'
+ #'renameCategory:to:'
+ ) 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) 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
+ ].
]
].
- upd := Class updateChanges:false.
-
- changeNrProcessed := changeNr.
- [
- (skipSignal notNil) ifTrue:[
- sig := skipSignal
- ] ifFalse:[
- sig := Object abortSignal
- ].
- sig catch:[
- aStream fileInNextChunkNotifying:self
- ].
- changeNrProcessed := nil.
- ] valueNowOrOnUnwindDo:[
- Class updateChanges:upd.
- aStream close
+ "
+ 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
!
-changeFileName:aFileName
- changeFileName := aFileName
-!
-
-setChangeList
- "extract type-information from changes and stuff into top selection
- view"
+autoSelectOrEnd:changeNr
+ |last|
-"/ changeListView list:changeHeaderLines "changeChunks".
-changeListView setList:changeHeaderLines expandTabs:false.
- self disableMenuEntries
-!
-
-silentDeleteChange:changeNr
- "delete a change do not update changeListView"
-
- anyChanges := true.
- changeChunks removeIndex:changeNr.
- changePositions removeIndex:changeNr.
- changeClassNames removeIndex:changeNr.
- changeHeaderLines removeIndex:changeNr
+ last := changePositions size.
+ changeNr < last ifTrue:[
+ self autoSelect:changeNr
+ ] ifFalse:[
+ self clearCodeView.
+ changeListView selection:last .
+ self changeSelection:last .
+ ]
!
writeBackChanges
"write back the changes file"
- |inStream outStream chunk sawExcla excla done dir|
+ |inStream outStream|
outStream := FileStream newFileNamed:'n_changes'.
outStream isNil ifTrue:[
@@ -601,8 +638,13 @@
inStream isNil ifTrue:[^ nil].
self withCursor:(Cursor write) do:[
+ |excla sawExcla done dir chunk
+ nChanges "{Class:SmallInteger}" |
+
excla := inStream class chunkSeparator.
- 1 to:(changePositions size) do:[:index |
+ nChanges := changePositions size.
+
+ 1 to:nChanges do:[:index |
inStream position:(changePositions at:index).
sawExcla := inStream peekFor:excla.
chunk := inStream nextChunk.
@@ -611,7 +653,9 @@
outStream nextPut:excla.
outStream nextChunkPut:chunk.
outStream cr.
- "a method-definition chunk - skip followups"
+ "
+ a method-definition chunk - skip followups
+ "
done := false.
[done] whileFalse:[
chunk := inStream nextChunk.
@@ -631,8 +675,7 @@
outStream close.
inStream close.
dir := FileDirectory currentDirectory.
-"/ dir removeFile:changeFileName.
- dir renameFile:'changes' newName:'changes.bak'.
+ dir renameFile:changeFileName newName:'changes.bak'.
dir renameFile:'n_changes' newName:changeFileName.
anyChanges := false
]
@@ -643,94 +686,14 @@
changeListView deselect.
self silentDeleteChange:changeNr.
- self setChangeList "/changeListView setContents:changeChunks
+ self setChangeList
!
-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].
+queryCloseText
+ "made this a method for easy redefinition in subclasses"
- "
- 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
-!
-
-deleteChangesFrom:start to:stop
- "delete a range of changes"
-
- changeListView deselect.
- stop to:start by:-1 do:[:changeNr |
- self silentDeleteChange:changeNr
- ].
- self setChangeList "/changeListView setContents:changeChunks
-
-!
-
-readChangesFile
- "read the changes file, create a list of header-lines (changeChunks)
- and a list of chunk-positions (changePositions)"
-
- ^ self readChangesFileInBackground:false
+ ^ 'Quit without updating changeFile ?'
!
compareChange:changeNr
@@ -794,6 +757,28 @@
aStream close.
!
+deleteChangesFrom:start to:stop
+ "delete a range of changes"
+
+ changeListView deselect.
+ stop to:start by:-1 do:[:changeNr |
+ self silentDeleteChange:changeNr
+ ].
+ self setChangeList
+
+!
+
+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."
@@ -868,6 +853,130 @@
! !
+!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.
+ codeView readOnly.
+
+ anyChanges := false.
+ ObjectMemory addDependent:self. "to get shutdown-update"
+!
+
+initializeMiddleButtonMenu
+ |labels|
+
+ labels := resources array:#(
+ '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').
+
+ changeListView
+ middleButtonMenu:(PopUpMenu
+ labels:labels
+ 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)
+ receiver:self
+ for:changeListView)
+!
+
+realize
+ super realize.
+ self readChangesFileInBackground:true.
+ 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:'user interaction'!
changeSelection:lineNr
@@ -889,6 +998,21 @@
self enableMenuEntries
!
+doApply
+ "user wants a change to be applied"
+
+ |changeNr|
+
+ changeNr := changeListView selection.
+ changeNr notNil ifTrue:[
+ self withCursor:(Cursor execute) do:[
+ skipSignal := nil.
+ self applyChange:changeNr.
+ self autoSelect:(changeNr + 1)
+ ]
+ ]
+!
+
noChangesAllowed
"show a warning that changes cannot be changed"
@@ -907,21 +1031,6 @@
self doSaveClassFrom:1
!
-doApply
- "user wants a change to be applied"
-
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self withCursor:(Cursor execute) do:[
- skipSignal := nil.
- self applyChange:changeNr.
- self autoSelect:(changeNr + 1)
- ]
- ]
-!
-
doSaveClassRest
"user wants changes for some class from current to end to be appended to a file"
@@ -933,37 +1042,6 @@
]
!
-saveClass:aClassName from:startNr
- "user wants changes from current to end to be appended to a file"
-
- |changeNr classNameToSave fileBox|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- fileBox := FileSelectionBox new.
- fileBox title:'append change to:'.
- fileBox okText:'append'.
- fileBox abortText:'cancel'.
- fileBox action:[:fileName |
- |thisClassName|
- self withCursor:(Cursor write) do:[
- startNr to:(changePositions size) do:[:changeNr |
- thisClassName := self classNameOfChange:changeNr.
- thisClassName = aClassName ifTrue:[
- changeListView selection:changeNr.
- (self appendChange:changeNr toFile:fileName) ifFalse:[
- ^ self
- ]
- ]
- ]
- ]
- ].
-
- fileBox pattern:'*.chg'.
- fileBox showAtPointer
- ]
-!
-
doBrowse
"user wants a browser on the class of a change"
@@ -980,6 +1058,38 @@
]
!
+saveClass:aClassName from:startNr
+ "user wants changes from current to end to be appended to a file"
+
+ |changeNr fileBox|
+
+ changeNr := changeListView selection.
+ changeNr notNil ifTrue:[
+ fileBox := FileSelectionBox new.
+ fileBox title:'append change to:'.
+ fileBox okText:'append'.
+ fileBox abortText:'cancel'.
+ fileBox action:[:fileName |
+ |thisClassName|
+
+ self withCursor:(Cursor write) do:[
+ startNr to:(changePositions size) do:[:changeNr |
+ thisClassName := self classNameOfChange:changeNr.
+ thisClassName = aClassName ifTrue:[
+ changeListView selection:changeNr.
+ (self appendChange:changeNr toFile:fileName) ifFalse:[
+ ^ self
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ fileBox pattern:'*.chg'.
+ fileBox showAtPointer
+ ]
+!
+
doSaveClassFrom:startNr
"user wants changes from current to end to be appended to a file"
@@ -1021,6 +1131,18 @@
]
!
+doDelete
+ "delete currently selected change"
+
+ |changeNr|
+
+ changeNr := changeListView selection.
+ changeNr notNil ifTrue:[
+ self deleteChange:changeNr.
+ self autoSelectOrEnd:changeNr
+ ]
+!
+
doSave
"user wants a change to be appended to a file"
@@ -1044,17 +1166,28 @@
]
!
+doUpdate
+ "reread the changes-file"
+
+ self readChangesFileInBackground:true.
+ realized ifTrue:[
+ self setChangeList.
+ changeListView hasSelection ifTrue:[self enableMenuEntries]
+ ]
+!
+
doMakePermanent
"user wants a change to be made permanent
- rewrite the source file where this change has to go"
- |changeNr yesNoBox|
+ |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:[
+ yesNoBox okAction:[ |changeNr|
+
changeNr := changeListView selection.
changeNr notNil ifTrue:[
self makeChangePermanent:changeNr.
@@ -1077,18 +1210,6 @@
]
!
-doDelete
- "delete currently selected change"
-
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self deleteChange:changeNr.
- self autoSelectOrEnd:changeNr
- ]
-!
-
doApplyRest
"user wants all changes from changeNr to be applied"
@@ -1099,50 +1220,10 @@
self withCursor:(Cursor execute) do:[
self clearCodeView.
skipSignal isNil ifTrue:[skipSignal := Signal new].
-"/ Object abortSignal catch:[
- changeNr to:(changePositions size) do:[:changeNr |
- changeListView selection:changeNr.
- self applyChange:changeNr
-"/ ]
- ].
-"/ skipSignal := nil
- ]
- ]
-!
-
-doApplyAll
- "user wants all changes to be applied"
-
- self withCursor:(Cursor execute) do:[
- self clearCodeView.
- skipSignal isNil ifTrue:[skipSignal := Signal new].
-"/ Object abortSignal catch:[
- 1 to:(changePositions size) do:[:changeNr |
+ changeNr to:(changePositions size) do:[:changeNr |
changeListView selection:changeNr.
self applyChange:changeNr
-"/ ]
- ].
-"/ skipSignal := nil
- ]
-!
-
-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 silentDeleteChangesFor:classNameToDelete
- from:changeNr
- to:(changePositions size).
- self setChangeList. "/changeListView setContents:changeChunks.
- self autoSelectOrEnd:changeNr
- ]
+ ].
]
]
!
@@ -1160,49 +1241,12 @@
]
!
-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 silentDeleteChangesFor:classNameToDelete
- from:1
- to:(changePositions size).
- self setChangeList. "/changeListView setContents:changeChunks.
- self autoSelectOrEnd:changeNr
- ]
- ]
- ]
-!
-
-doWriteBack
- "write back the list onto the changes file"
-
- anyChanges ifTrue:[
- self writeBackChanges.
- realized ifTrue:[
- self readChangesFileInBackground:false.
- realized ifTrue:[
- self setChangeList
- ]
- ]
- ]
-!
-
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 snapshotProto str snapshotPrefix snapshotNameIndex fileName|
+ |aStream searchIndex anyMore deleteSet index
+ str snapshotProto snapshotPrefix snapshotNameIndex fileName|
aStream := FileStream readonlyFileNamed:changeFileName.
aStream isNil ifTrue:[^ self].
@@ -1218,6 +1262,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.
@@ -1314,13 +1362,16 @@
"finally delete what has been found"
(deleteSet size > 0) ifTrue:[
- changeListView selection:nil.
+ 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
].
@@ -1329,12 +1380,16 @@
]
!
-doUpdate
- "reread the changes-file"
+doApplyAll
+ "user wants all changes to be applied"
- self readChangesFileInBackground:true.
- realized ifTrue:[
- self setChangeList
+ 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
+ ].
]
!
@@ -1350,6 +1405,133 @@
self compareChange:changeNr
]
]
+!
+
+doDeleteClassRest
+ "delete rest of changes with same class as currently selected change"
+
+ |changeNr|
+
+ changeNr := changeListView selection.
+ changeNr notNil ifTrue:[
+ self withCursor:(Cursor execute) do:[
+ | classNameToDelete |
+
+ classNameToDelete := self classNameOfChange:changeNr.
+ classNameToDelete notNil ifTrue:[
+ changeListView selection:nil.
+ self silentDeleteChangesFor:classNameToDelete
+ from:changeNr
+ to:(changePositions size).
+ self setChangeList.
+ self autoSelectOrEnd:changeNr
+ ]
+ ]
+ ]
+!
+
+doWriteBack
+ "write back the list onto the changes file"
+
+ anyChanges ifTrue:[
+ self writeBackChanges.
+ realized ifTrue:[
+ self readChangesFileInBackground:false.
+ realized ifTrue:[
+ self setChangeList
+ ]
+ ]
+ ]
+!
+
+doDeleteClassAll
+ "delete all changes with same class as currently selected change"
+
+ |changeNr|
+
+ changeNr := changeListView selection.
+ changeNr notNil ifTrue:[
+ self withCursor:(Cursor execute) do:[
+ | 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"
+
+ |changeNr |
+
+ changeNr := changeListView selection.
+ changeNr notNil ifTrue:[
+ self withCursor:(Cursor execute) do:[
+ |thisClassName classNameToApply|
+
+ 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
+ ].
+ ].
+ ]
+ ]
+ ]
+
+
+! !
+
+!ChangesBrowser methodsFor:'termination'!
+
+terminate
+ "window manager wants us to go away"
+
+ |box|
+
+ anyChanges ifTrue:[
+ box := OptionBox title:'' numberOfOptions:3.
+ box title:(resources at:'close ChangesBrowser.\\changefile has not been updated from the modified changelist.\\Update before closing ?') withCRs.
+ box buttonTitles:(resources array:#('abort' 'don''t update' 'update')).
+ box actions:(Array with:[^ self]
+ with:[self destroy]
+ with:[self writeBackChanges. self destroy]
+ ).
+ box showAtPointer.
+ ] ifFalse:[
+ 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'!
@@ -1395,6 +1577,12 @@
^ 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 ??).
@@ -1432,11 +1620,5 @@
^ false
].
^ codeView error:aString position:relPos to:relEndPos
-!
-
-warning:aString position:relPos to:relEndPos
- "compiler notifys us of a warning - ignore it"
-
- ^ self
! !