--- a/ChangesBrowser.st Mon Nov 13 13:05:01 2006 +0100
+++ b/ChangesBrowser.st Mon Nov 13 13:05:19 2006 +0100
@@ -1594,17 +1594,15 @@
newLabel:how
|l|
- (changeFileName ~= 'changes') ifTrue:[
- l := self class defaultLabel , ': ', changeFileName
- ] ifFalse:[
- l := self class defaultLabel
+ l := self class defaultLabel.
+ (changeFileName notNil and:[changeFileName ~= 'changes']) ifTrue:[
+ l := l , ': ', changeFileName
].
l := l , ' ' , how.
self label:l
- "Created: / 8.9.1995 / 19:32:04 / claus"
- "Modified: / 8.9.1995 / 19:39:29 / claus"
- "Modified: / 6.2.1998 / 13:27:01 / cg"
+ "Created: / 08-09-1995 / 19:32:04 / claus"
+ "Modified: / 12-11-2006 / 16:23:53 / cg"
!
oldSourceForParseTree:parseTree
@@ -3203,187 +3201,192 @@
otherwise, only changes for that class are compressed."
|lbl aStream searchIndex anyMore deleteSet index
- str snapshotProto snapshotPrefix snapshotNameIndex fileName|
-
- aStream := changeFileName asFilename readStreamOrNil.
- aStream isNil ifTrue:[^ self].
+ str snapshotProto snapshotPrefix snapshotNameIndex|
+
+ changeFileName notNil ifTrue:[
+ aStream := changeFileName asFilename readStreamOrNil.
+ aStream isNil ifTrue:[^ self].
+ ].
lbl := 'compressing'.
aClassNameOrNil isNil ifTrue:[
- selectorToCompressOrNil notNil ifTrue:[
- lbl := lbl , ' for ' , selectorToCompressOrNil.
- ]
+ selectorToCompressOrNil notNil ifTrue:[
+ lbl := lbl , ' for ' , selectorToCompressOrNil.
+ ]
] ifFalse:[
- selectorToCompressOrNil isNil ifTrue:[
- lbl := lbl , ' for ' , aClassNameOrNil.
- ] ifFalse:[
- lbl := lbl , ' for ' , aClassNameOrNil , '>>' , selectorToCompressOrNil.
- ]
+ selectorToCompressOrNil isNil ifTrue:[
+ lbl := lbl , ' for ' , aClassNameOrNil.
+ ] ifFalse:[
+ lbl := lbl , ' for ' , aClassNameOrNil , '>>' , selectorToCompressOrNil.
+ ]
].
lbl := lbl , '...'.
self newLabel:lbl.
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'.
+ "
+ 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
- compressThis|
-
- 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 position1Based:(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:[
- (#(
- #methodsFor:
- #privateMethodsFor:
- #publicMethodsFor:
- #ignoredMethodsFor:
- #protectedMethodsFor:
- #methodsFor:stamp: "/ Squeak support
- #methodsFor "/ Dolphin support
- #methods "/ STV support
- )
- includes:aParseTree selector) 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 position1Based: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 occurrence 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.
-
- compressThis := false.
- aClassNameOrNil isNil ifTrue:[
- compressThis := true
- ] ifFalse:[
- "/ skipping unloaded/unknown classes
- thisClass isBehavior ifTrue:[
- compressThis := aClassNameOrNil = thisClass theNonMetaclass name.
- ]
- ].
- compressThis ifTrue:[
- thisSelector := selectors at:changeNr.
- compressThis := (selectorToCompressOrNil isNil or:[thisSelector == selectorToCompressOrNil]).
- compressThis ifTrue:[
- 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
- ]
+ |numChanges classes selectors types excla sawExcla
+ chunk aParseTree parseTreeChunk
+ thisClass thisSelector codeChunk codeParser
+ compressThis fileName|
+
+ 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"
+
+ aStream notNil ifTrue:[
+ excla := aStream class chunkSeparator.
+ numChanges to:1 by:-1 do:[:changeNr |
+ aStream position1Based:(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:[
+ (#(
+ #methodsFor:
+ #privateMethodsFor:
+ #publicMethodsFor:
+ #ignoredMethodsFor:
+ #protectedMethodsFor:
+ #methodsFor:stamp: "/ Squeak support
+ #methodsFor "/ Dolphin support
+ #methods "/ STV support
+ )
+ includes:aParseTree selector) 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 position1Based:snapshotNameIndex.
+ fileName := str upTo:(Character space).
+ "
+ kludge to allow use of match-check below
+ "
+ selectors at:changeNr put:snapshotPrefix.
+ classes at:changeNr put:fileName.
+ ]
+ ]
+ ]
+ ].
+ ].
+ aStream close.
+ ] ifFalse:[
+ numChanges to:1 by:-1 do:[:changeNr |
+ |change|
+
+ classes at:changeNr put:(self classOfChange:changeNr ifAbsent:[:className| nil]).
+ selectors at:changeNr put:(self selectorOfMethodChange:changeNr).
+ ].
+ ].
+
+ "for all changes, look for another class/selector occurrence later
+ in the list and, if there is one, add change number to the delete set"
+
+ deleteSet := OrderedCollection new.
+ 1 to:self numberOfChanges-1 do:[:changeNr |
+ thisClass := classes at:changeNr.
+
+ compressThis := false.
+ aClassNameOrNil isNil ifTrue:[
+ compressThis := true
+ ] ifFalse:[
+ "/ skipping unloaded/unknown classes
+ thisClass isBehavior ifTrue:[
+ compressThis := aClassNameOrNil = thisClass theNonMetaclass name.
+ ]
+ ].
+ compressThis ifTrue:[
+ thisSelector := selectors at:changeNr.
+ compressThis := (selectorToCompressOrNil isNil or:[thisSelector == selectorToCompressOrNil]).
+ compressThis ifTrue:[
+ 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
+ ]
+ ].
+ ].
+ ].
+ ].
+
+ "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:''.
- "Modified: / 5.11.2001 / 16:34:53 / cg"
- "Created: / 19.11.2001 / 22:03:42 / cg"
+ "Created: / 19-11-2001 / 22:03:42 / cg"
+ "Modified: / 13-11-2006 / 11:00:03 / cg"
!
deleteChange:changeNr
@@ -5856,5 +5859,5 @@
!ChangesBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.359 2006-10-23 21:15:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.360 2006-11-13 12:05:19 cg Exp $'
! !