--- a/NewChangesBrowser.st Wed Aug 30 12:12:16 2000 +0200
+++ b/NewChangesBrowser.st Wed Aug 30 12:13:29 2000 +0200
@@ -1,3 +1,5 @@
+"{ Package: 'stx:libtool' }"
+
ToolApplicationModel subclass:#NewChangesBrowser
instanceVariableNames:'changes changeFileName skipSignal changeFileTimestamp
autoUpdateBlock filterCompletionBlock editingClassSource modified'
@@ -1290,14 +1292,14 @@
|holder|
(holder := builder bindingAt:#listOfChangeColumns) isNil ifTrue:[
- builder aspectAt:#listOfChangeColumns put:(holder := List new).
- self changeColumn: nil add: true.
- self changeColumn: #change add: true.
- self categoryColumn: self categoryColumn.
- self timeStampColumn: self timeStampColumn.
- self typeColumn: self typeColumn.
- self deltaInfoColumn: self deltaInfoColumn.
- self positionsColumn: self positionsColumn.
+ builder aspectAt:#listOfChangeColumns put:(holder := List new).
+ self changeColumn: nil add: true.
+ self changeColumn: #change add: true.
+ self categoryColumn: self categoryColumn.
+ self timeStampColumn: self timeStampColumn.
+ self typeColumn: self typeColumn.
+"/ self deltaInfoColumn: self deltaInfoColumn.
+ self positionsColumn: self positionsColumn.
].
^ holder
@@ -2362,22 +2364,22 @@
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
+ 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|
+ |aStream maxLen i f v|
self valueOfNotReading value: false.
self valueOfHavingSelection value: false.
@@ -2397,328 +2399,330 @@
changeFileTimestamp := i modified.
self valueOfReadProgress value: 0.
- self readProgressIndicator raise.
- self filterLabel label: 'Read:'; redraw.
+ v := self readProgressIndicator.
+ v notNil ifTrue:[v raise].
+ v := self filterLabel.
+ v notNil ifTrue:[v label: 'Read:'; redraw].
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 lastChange|
-
- excla := aStream class chunkSeparator.
-
- [aStream atEnd] whileFalse:[
- |change changeDelta changeString changeType changeCategory
- line s l changeClass sawExcla category
- chunkText chunkPos sel oldValue|
-
- change := Change new.
- "
- get a chunk (separated by excla)
- "
- oldValue := self valueOfReadProgress value.
- self valueOfReadProgress value: (((aStream position/aStream size) * 100) rounded).
- oldValue ~~ self valueOfReadProgress value
- ifTrue: [self readProgressIndicator redrawEdges;redraw].
-
- 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
- ].
- ].
-
- change chunk: chunkText.
- change position: chunkPos.
- lastChange notNil ifTrue: [lastChange lastPosition: chunkPos - 1].
- lastChange := change.
- change timeStamp: timeStampInfo.
- change followUp: 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.
-
- DeltaInfoColumn 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:[
- |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:[
- change := Change new.
- change chunk: chunkText.
- change string:changeString.
- change position: methodPos.
- change className: className.
- lastChange notNil ifTrue: [lastChange lastPosition: methodPos - 1].
- lastChange := change.
- change timeStamp: timeStampInfo.
- change followUp: 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 definition'.
- changeCategory := category.
- headerLine := className , ' ' , sel , ' ' , '(change category: ''' , category , ''')'.
- ].
-
- DeltaInfoColumn 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 := '='
- ]
- ]
- ]
- ]
- ]
- ].
- change delta:changeDelta.
- change string:changeString.
- change type:changeType.
- change category: changeCategory.
- change timeStamp:timeStampInfo.
- changes add:change.
- ].
- changeString := nil.
- headerLine := nil.
-
- ]
- ].
- changeString notNil ifTrue:[
- change delta:changeDelta.
- change string:changeString.
- change type:changeType.
- change timeStamp:timeStampInfo.
- changes add:change.
-
- ] ifFalse:[
- headerLine notNil ifTrue:[
- changes add: change.
- ]
- ]
- ]
- ].
- change lastPosition: aStream position.
- ].
- modified := false.
-
- ] valueNowOrOnUnwindDo:[
- aStream close.
- inBackground ifTrue:[myProcess priority:myPriority].
- ].
+ |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 lastChange|
+
+ excla := aStream class chunkSeparator.
+
+ [aStream atEnd] whileFalse:[
+ |change changeDelta changeString changeType changeCategory
+ line s l changeClass sawExcla category
+ chunkText chunkPos sel oldValue|
+
+ change := Change new.
+ "
+ get a chunk (separated by excla)
+ "
+ oldValue := self valueOfReadProgress value.
+ self valueOfReadProgress value: (((aStream position/aStream size) * 100) rounded).
+"/ oldValue ~~ self valueOfReadProgress value
+"/ ifTrue: [self readProgressIndicator redrawEdges;redraw].
+
+ 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
+ ].
+ ].
+
+ change chunk: chunkText.
+ change position: chunkPos.
+ lastChange notNil ifTrue: [lastChange lastPosition: chunkPos - 1].
+ lastChange := change.
+ change timeStamp: timeStampInfo.
+ change followUp: 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.
+
+ DeltaInfoColumn 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:[
+ |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:[
+ change := Change new.
+ change chunk: chunkText.
+ change string:changeString.
+ change position: methodPos.
+ change className: className.
+ lastChange notNil ifTrue: [lastChange lastPosition: methodPos - 1].
+ lastChange := change.
+ change timeStamp: timeStampInfo.
+ change followUp: 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 definition'.
+ changeCategory := category.
+ headerLine := className , ' ' , sel , ' ' , '(change category: ''' , category , ''')'.
+ ].
+
+ DeltaInfoColumn 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 := '='
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ change delta:changeDelta.
+ change string:changeString.
+ change type:changeType.
+ change category: changeCategory.
+ change timeStamp:timeStampInfo.
+ changes add:change.
+ ].
+ changeString := nil.
+ headerLine := nil.
+
+ ]
+ ].
+ changeString notNil ifTrue:[
+ change delta:changeDelta.
+ change string:changeString.
+ change type:changeType.
+ change timeStamp:timeStampInfo.
+ changes add:change.
+
+ ] ifFalse:[
+ headerLine notNil ifTrue:[
+ changes add: change.
+ ]
+ ]
+ ]
+ ].
+ change lastPosition: aStream position.
+ ].
+ modified := false.
+
+ ] valueNowOrOnUnwindDo:[
+ aStream close.
+ inBackground ifTrue:[myProcess priority:myPriority].
+ ].
].
self setChangeList.
self valueOfNotReading value: true.
@@ -3517,5 +3521,5 @@
!NewChangesBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/NewChangesBrowser.st,v 1.24 1999-07-10 10:43:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/NewChangesBrowser.st,v 1.25 2000-08-30 10:13:29 cg Exp $'
! !