--- a/ChangesBrowser.st Tue Jan 31 10:26:35 2006 +0100
+++ b/ChangesBrowser.st Tue Jan 31 23:11:06 2006 +0100
@@ -28,6 +28,18 @@
category:'Interface-Browsers'
!
+Object subclass:#ChangeFileReader
+ instanceVariableNames:'browser enforcedNameSpace changeFileName changeFileSize
+ changeFileTimestamp changeChunks changeClassNames
+ changeHeaderLines changePositions changeTimeStamps
+ changeIsFollowupMethodChange autoCompare tabSpec anyChanges
+ inStream thisIsAClassSource chunkText chunkPosition sawExcla
+ fullChunkText noColoring'
+ classVariableNames:'NoColoring'
+ poolDictionaries:''
+ privateIn:ChangesBrowser
+!
+
!ChangesBrowser class methodsFor:'documentation'!
copyright
@@ -1552,55 +1564,6 @@
changeNrShown := nil
!
-contractClass:className selector:selector to:maxLen
- "contract a class>>selector string (for display in the changeList)."
-
- |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
-!
-
-extractClassAndClassNameFromParseTree:rec
- |isUnaryMessage className changeClass|
-
- isUnaryMessage := rec isUnaryMessage.
-
- isUnaryMessage ifTrue:[
- className := rec receiver name.
- ] ifFalse:[
- className := rec name.
- ].
-
- enforcedNameSpace notNil ifTrue:[
- changeClass := enforcedNameSpace classNamed:className.
- ].
- changeClass isNil ifTrue:[
- changeClass := Smalltalk classNamed:className.
- ].
- isUnaryMessage ifTrue:[
- changeClass notNil ifTrue:[
- changeClass := changeClass class.
- ].
- className := className , ' class'.
- ].
-
- ^ className -> changeClass
-!
-
isChangeSetBrowser
^ false
!
@@ -2416,7 +2379,8 @@
'+' -> 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
+ '=' -> change is the same as current methods source
+ '~' -> change is almost the same as current methods source
2 class/selector
3 type of change
doit
@@ -2427,20 +2391,12 @@
since comparing slows down startup time, it is now disabled by
default and can be enabled via a toggle."
- |inStream maxLen i f chunkText fullChunkText askedForEditingClassSource
- excla timeStampInfo entry changeDelta changeString changeType
- s changeClass sawExcla category
- chunkPos sel headerLine cls p rec clsName
- myProcess myPriority myPrioRange
- done first text methodPos
- singleJunkOnly methodChunks classCategoryChunks methodCategoryChunks singleInfo
- ownerTree ownerName
- m currentText t1 t2 methodSelector nameAndClass encoding decoder|
+ |inStream i f askedForEditingClassSource myProcess myPriority myPrioRange encoding decoder|
editingClassSource := false.
askedForEditingClassSource := false.
- maxLen := 60.
+"/ maxLen := 60.
self newLabel:'updating ...'.
@@ -2472,504 +2428,28 @@
myPriority := myProcess priority.
myPrioRange := myProcess priorityRange.
myProcess priorityRange:(Processor userBackgroundPriority to:Processor activePriority).
-"/ myProcess priority:(Processor userBackgroundPriority).
].
[
- changeChunks := OrderedCollection new.
- changeClassNames := OrderedCollection new.
- changeHeaderLines := OrderedCollection new.
- changePositions := OrderedCollection new.
- changeTimeStamps := OrderedCollection new.
- changeIsFollowupMethodChange := OrderedCollection new.
-
- excla := inStream class chunkSeparator.
-
- [inStream atEnd] whileFalse:[
- "
- get a chunk (separated by excla)
- "
- inStream skipSeparators.
- chunkPos := inStream position1Based.
-
-
- sawExcla := inStream peekFor:excla.
- chunkText := fullChunkText := inStream nextChunk.
- chunkText notNil ifTrue:[
-
- (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.
- changeClassNames add:nil.
- 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) withoutSeparators.
- timeStampInfo := nil.
- ] ifFalse:[
-
- 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) withoutSeparators.
-
- p := Parser parseExpression:fullChunkText inNameSpace:Smalltalk.
- (p notNil and:[p ~~ #Error]) ifTrue:[
- p isMessage ifTrue:[
- sel := p selector.
- rec := p receiver.
- ]
- ] ifFalse:[
- sel := nil.
- (Scanner new scanTokens:fullChunkText) size == 0 ifTrue:[
- "/ a comment only
- changeType := '(comment)'.
- NoColoring ~~ true ifTrue:[
- changeType := changeType allItalic.
- "/ changeString := changeString allItalic.
- changeType emphasisAllAdd:(#color -> UserPreferences current commentColor).
- ]
- ] ifFalse:[
- changeType := '(???)'.
- ]
- ].
-
- (sel == #comment:) ifTrue:[
- changeType := '(comment)'.
- clsName := rec name.
- changeClass := (self nameSpaceForApply) classNamed:clsName.
- changeClassNames at:changeClassNames size put:clsName.
- NoColoring ~~ true ifTrue:[
- changeType := changeType allItalic.
- changeType emphasisAllAdd:(#color -> UserPreferences current commentColor).
- "/ changeString := clsName allItalic.
- ].
- autoCompare value ifTrue:[
- (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[
- changeDelta := '?'
- ] ifFalse:[
- (changeClass comment = (p args at:1) evaluate) ifTrue:[
- changeDelta := '='.
- ]
- ]
- ].
- sel := nil.
- ].
-
- (sel == #removeSelector:) ifTrue:[
- nameAndClass := self extractClassAndClassNameFromParseTree:rec.
- clsName := nameAndClass key. changeClass := nameAndClass value.
-
- sel := (p args at:1) evaluate.
- changeClassNames at:changeClassNames size put:clsName.
-
- autoCompare value ifTrue:[
- (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[
- changeDelta := '?'
- ] ifFalse:[
- (changeClass includesSelector:sel asSymbol) ifTrue:[
- changeDelta := '-'.
- ] ifFalse:[
- changeDelta := '='.
- ]
- ]
- ].
- changeType := '(remove)'.
- changeString := self contractClass:clsName selector:sel to:maxLen.
- sel := nil.
- ].
-
- (p notNil
- and:[p ~~ #Error
- and:[p isMessage
- and:[rec isMessage
- and:[rec selector == #compiledMethodAt:]]]]) ifTrue:[
- nameAndClass := self extractClassAndClassNameFromParseTree:rec receiver.
- clsName := nameAndClass key. changeClass := nameAndClass value.
-
- (sel == #category:) ifTrue:[
- sel := (rec args at:1) evaluate.
- changeType := '(category change)'.
- changeString := self contractClass:clsName selector:sel to:maxLen.
- changeClassNames at:changeClassNames size put:clsName.
- changeClass notNil ifTrue:[
- m := changeClass compiledMethodAt:sel asSymbol.
- m notNil ifTrue:[
- m category = (p args at:1) evaluate ifTrue:[
- changeDelta := '='.
- ]
- ]
- ].
- ].
- (sel == #privacy:) ifTrue:[
- sel := (rec args at:1) evaluate.
- changeType := '(privacy change)'.
- changeString := self contractClass:clsName selector:sel to:maxLen.
- changeClassNames at:changeClassNames size put:clsName.
- ].
- sel := nil.
- ].
-
- (Class definitionSelectors includes:sel) ifTrue:[
- changeType := '(class definition)'.
- clsName := (p args at:1) evaluate.
- changeClassNames at:changeClassNames size put:clsName.
-
- "/ is it a private-class ?
- ('*privateIn:' match:sel) ifTrue:[
- ownerTree := p args last.
- ownerName := ownerTree name asString.
- clsName := ownerName , '::' , clsName
- ].
-
- changeString := clsName.
- NoColoring ~~ true ifTrue:[
- changeType := changeType allBold.
- changeString := changeString allBold.
- ].
-
- autoCompare value ifTrue:[
- cls := (self nameSpaceForApply) at:clsName asSymbol ifAbsent:nil.
- cls isNil ifTrue:[
- changeDelta := '+'.
- ] ifFalse:[
- (cls definitionSelector = sel
- or:[
- "/ could be an ST/V, VAge or Dolphin definition
- cls definitionSelector = (sel , 'category:')
- ])
- ifTrue:[
- ((cls superclass isNil
- and:[p receiver isConstant
- and:[p receiver evaluate isNil]])
- or:[
- cls superclass notNil
- and:[p receiver isConstant not
- and:[cls superclass name = p receiver name]]
- ]) ifTrue:[
- cls instanceVariableString asCollectionOfWords = (p args at:2) evaluate asCollectionOfWords ifTrue:[
- cls classVariableString asCollectionOfWords = (p args at:3) evaluate asCollectionOfWords ifTrue:[
- (p args at:4) evaluate isEmpty ifTrue:[
- cls definitionSelector = (sel , 'category:')
- ifTrue:[
- "/ ST/V, VAge or Dolphin definition
- changeDelta := '='.
- ] ifFalse:[
- cls category = (p args at:5) evaluate ifTrue:[
- changeDelta := '='.
- ] ifFalse:[
- changeType := '(class category change)'.
- ]
- ]
- ]
- ]
- ]
- ]
- ]
- ]
- ].
- sel := nil.
- ] ifFalse:[
- (#(
- #'primitiveDefinitions:'
- #'primitiveFunctions:'
- #'primitiveVariables:'
- ) includes:sel) ifTrue:[
- changeType := '(class definition)'.
- clsName := rec evaluate.
- ] ifFalse:[
- ((sel == #instanceVariableNames:)
- and:[rec isMessage
- and:[rec selector == #class]]) ifTrue:[
- clsName := rec receiver name.
- changeClass := (self nameSpaceForApply) classNamed:clsName.
- changeType := '(class definition)'.
- changeClassNames at:changeClassNames size put:clsName.
-
- autoCompare value ifTrue:[
- changeClass isNil ifTrue:[
- changeDelta := '?'.
- ] ifFalse:[
- s := (p args at:1) evaluate.
- s = changeClass class instanceVariableString ifTrue:[
- changeDelta := '='.
- ]
- ]
- ].
- ]
- ]
- ].
- ]
- ] ifTrue:[ "sawExcla"
- singleJunkOnly := false.
- methodChunks := false.
- classCategoryChunks := methodCategoryChunks := false.
- singleInfo := false.
-
- "
- 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 ....
- "
- clsName := nil.
- p := Parser parseExpression:chunkText inNameSpace:(self nameSpaceForApply).
-
- (p notNil and:[p ~~ #Error]) ifTrue:[
- rec := p receiver.
- sel := p selector.
- (#(
- #methodsFor:
- #privateMethodsFor:
- #publicMethodsFor:
- #ignoredMethodsFor:
- #protectedMethodsFor:
- #methodsFor:stamp: "/ Squeak support
- #'commentStamp:prior:' "/ Squeak support
- #methodsFor "/ Dolphin support
- #categoriesForClass "/ Dolphin support
- #categoriesFor: "/ Dolphin support
- #methods "/ STV support
- #publicMethods "/ STV support
- #methodsForUndefined:
- )
- includes:sel) ifTrue:[
- methodChunks := true.
- nameAndClass := self extractClassAndClassNameFromParseTree:rec.
- clsName := nameAndClass key. changeClass := nameAndClass value.
-
- sel == #categoriesForClass ifTrue:[
- methodChunks := false.
- classCategoryChunks := true.
- changeType := '(class category change)'.
- ] ifFalse:[
- sel == #categoriesFor: ifTrue:[
- methodChunks := false.
- methodCategoryChunks := true.
- changeType := '(category change)'.
- methodSelector := (p args at:1) evaluate.
- ] ifFalse:[
- (sel == #'methodsFor') ifTrue:[
- category := 'Dolphin methods'.
- ] ifFalse:[
- ((sel == #methods) or:[sel == #publicMethods]) ifTrue:[
- category := 'STV methods'.
- ] ifFalse:[
- category := (p args at:1) evaluate.
- ]
- ].
- ].
- ].
-
- sel == #'methodsFor:stamp:' ifTrue:[
- "/ Squeak timeStamp
- timeStampInfo := (p args at:2) evaluate.
- singleInfo := true
- ] ifFalse:[
- sel == #'commentStamp:prior:' ifTrue:[
- singleJunkOnly := true.
- methodChunks := false.
- ]
- ]
- ] ifFalse:[
- sel == #reorganize ifTrue:[
- singleJunkOnly := true.
- methodChunks := false.
- ]
- ].
- ].
-
- done := false.
- first := true.
- [done] whileFalse:[
- changeDelta := ' '.
- methodPos := inStream position1Based.
-
- text := inStream nextChunk.
- done := text isEmptyOrNil.
-
- done ifFalse:[
- first ifFalse:[
- changeChunks add:chunkText.
- changeClassNames add:clsName.
- changePositions add:methodPos.
- changeTimeStamps add:timeStampInfo.
- changeIsFollowupMethodChange add:true.
- askedForEditingClassSource ifFalse:[
- (changeFileName asFilename hasSuffix:'st') ifFalse:[
- editingClassSource := false.
-"
-editingClassSource := (self confirm:'Multiple method chunks without individual ''methodsFor:'' encountered.
-Is this a class-file being browsed ?')
-"
- ] ifTrue:[
- editingClassSource := true.
- ].
- askedForEditingClassSource := true.
- ]
- ] ifTrue:[
- changeClassNames at:changeClassNames size put:clsName.
- ].
-
- first := false.
-
- (classCategoryChunks or:[methodCategoryChunks]) ifTrue:[
- text := text asCollectionOfLines first asString.
- classCategoryChunks ifTrue:[
- changeClass isNil ifTrue:[
- changeDelta := '?'.
- ] ifFalse:[
- changeClass category = text ifTrue:[
- changeDelta := '='.
- ]
- ].
- changeString := clsName , ' category: ' , text storeString.
- ]ifFalse:[
- changeString := '(' , clsName , ' compiledMethodAt:' , methodSelector storeString , ') category: ' , text storeString.
- ].
- ] ifFalse:[
- "
- try to find the selector
- "
- methodSelector := nil.
- clsName notNil ifTrue:[
- methodChunks ifTrue:[
- p := Parser
- parseMethodSpecification:text
- in:nil
- ignoreErrors:true
- ignoreWarnings:true.
- (p notNil and:[p ~~ #Error]) ifTrue:[
- methodSelector := p selector.
- ]
- ]
- ].
-
- methodSelector isNil ifTrue:[
- changeString := (chunkText contractTo:maxLen).
- changeType := '(change)'.
- headerLine := chunkText , ' (change)'.
- ] ifFalse:[
- changeString := self contractClass:clsName selector:methodSelector to:maxLen.
- changeType := '{ ' , category , ' }'.
- headerLine := clsName , ' ' , methodSelector , ' ' , '(change category: ''' , category , ''')'.
- ].
-
- autoCompare value ifTrue:[
- changeClass isNil ifFalse:[
- cls := changeClass theNonMetaclass
- ].
-
- (changeClass isNil or:[methodSelector isNil or:[cls isLoaded not]]) ifTrue:[
- changeClass isNil ifTrue:[
- changeDelta := '+'
- ] ifFalse:[
- changeDelta := '?'
- ]
- ] ifFalse:[
- (changeClass includesSelector:methodSelector asSymbol) ifFalse:[
- changeDelta := '+'.
- ] ifTrue:[
- m := changeClass compiledMethodAt:methodSelector asSymbol.
- currentText := m source.
- currentText notNil ifTrue:[
- text asString string withoutTrailingSeparators = currentText asString string withoutTrailingSeparators 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.
- singleJunkOnly ifTrue:[done := true]
- ].
- singleInfo ifTrue:[
- timeStampInfo := 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
- ]
- ]
- ]
- ]
- ].
+ |reader|
+
+ reader := ChangeFileReader new.
+ reader browser:self.
+ reader enforcedNameSpace:enforcedNameSpace.
+ reader autoCompare:autoCompare.
+ reader tabSpec:tabSpec.
+ reader inStream:inStream.
+ reader noColoring:(NoColoring == true).
+ reader readChangesFile.
+
+ editingClassSource := reader thisIsAClassSource.
+ changeChunks := reader changeChunks.
+ changeClassNames := reader changeClassNames.
+ changeHeaderLines := reader changeHeaderLines.
+ changePositions := reader changePositions.
+ changeTimeStamps := reader changeTimeStamps.
+ changeIsFollowupMethodChange := reader changeIsFollowupMethodChange.
+
anyChanges := false
] ensure:[
inStream close.
@@ -5685,8 +5165,626 @@
]
! !
+!ChangesBrowser::ChangeFileReader methodsFor:'accessing'!
+
+autoCompare:something
+ autoCompare := something.
+!
+
+browser:something
+ browser := something.
+!
+
+changeChunks
+ ^ changeChunks
+!
+
+changeClassNames
+ ^ changeClassNames
+!
+
+changeHeaderLines
+ ^ changeHeaderLines
+!
+
+changeIsFollowupMethodChange
+ ^ changeIsFollowupMethodChange
+!
+
+changePositions
+ ^ changePositions
+!
+
+changeTimeStamps
+ ^ changeTimeStamps
+!
+
+enforcedNameSpace:something
+ enforcedNameSpace := something.
+!
+
+inStream:something
+ inStream := something.
+!
+
+noColoring:something
+ noColoring := something.
+!
+
+tabSpec:something
+ tabSpec := something.
+!
+
+thisIsAClassSource
+ ^ thisIsAClassSource
+! !
+
+!ChangesBrowser::ChangeFileReader methodsFor:'private'!
+
+contractClass:className selector:selector to:maxLen
+ "contract a class>>selector string (for display in the changeList)."
+
+ |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
+!
+
+extractClassAndClassNameFromParseTree:rec
+ |isUnaryMessage className changeClass|
+
+ isUnaryMessage := rec isUnaryMessage.
+
+ isUnaryMessage ifTrue:[
+ className := rec receiver name.
+ ] ifFalse:[
+ className := rec name.
+ ].
+
+ enforcedNameSpace notNil ifTrue:[
+ changeClass := enforcedNameSpace classNamed:className.
+ ].
+ changeClass isNil ifTrue:[
+ changeClass := Smalltalk classNamed:className.
+ ].
+ isUnaryMessage ifTrue:[
+ changeClass notNil ifTrue:[
+ changeClass := changeClass class.
+ ].
+ className := className , ' class'.
+ ].
+
+ ^ className -> changeClass
+!
+
+nameSpaceForApply
+ ^ browser nameSpaceForApply
+! !
+
+!ChangesBrowser::ChangeFileReader methodsFor:'reading'!
+
+addHeaderLineForChangeType:changeType changeString:changeString changeDelta:changeDelta timeStampInfo:timeStampInfo
+ |entry|
+
+ 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
+!
+
+processChunk
+ |maxLen askedForEditingClassSource timeStampInfo changeDelta changeString changeType
+ s changeClass category
+ sel headerLine cls p rec clsName done first text methodPos
+ singleJunkOnly methodChunks classCategoryChunks methodCategoryChunks singleInfo
+ ownerTree ownerName
+ m currentText t1 t2 methodSelector nameAndClass|
+
+ maxLen := 60.
+
+
+ (chunkText startsWith:'''---- timestamp ') ifTrue:[
+ timeStampInfo := (chunkText copyFrom:16 to:(chunkText size - 6)) withoutSpaces.
+ ] ifFalse:[
+ changeChunks add:chunkText.
+ changeClassNames add:nil.
+ changePositions add:chunkPosition.
+ changeTimeStamps add:timeStampInfo.
+ changeIsFollowupMethodChange add:false.
+
+ headerLine := nil.
+ changeDelta := ' '.
+
+ sawExcla ifFalse:[
+ (chunkText startsWith:'''---- snap') ifTrue:[
+ changeType := ''.
+ headerLine := chunkText.
+ changeString := (chunkText contractTo:maxLen) withoutSeparators.
+ timeStampInfo := nil.
+ ] ifFalse:[
+
+ 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) withoutSeparators.
+
+ p := Parser parseExpression:fullChunkText inNameSpace:Smalltalk.
+ (p notNil and:[p ~~ #Error]) ifTrue:[
+ p isMessage ifTrue:[
+ sel := p selector.
+ rec := p receiver.
+ ]
+ ] ifFalse:[
+ sel := nil.
+ (Scanner new scanTokens:fullChunkText) size == 0 ifTrue:[
+ "/ a comment only
+ changeType := '(comment)'.
+ NoColoring ~~ true ifTrue:[
+ changeType := changeType allItalic.
+ "/ changeString := changeString allItalic.
+ changeType emphasisAllAdd:(#color -> UserPreferences current commentColor).
+ ]
+ ] ifFalse:[
+ changeType := '(???)'.
+ ]
+ ].
+
+ (sel == #comment:) ifTrue:[
+ changeType := '(comment)'.
+ clsName := rec name.
+ changeClass := (self nameSpaceForApply) classNamed:clsName.
+ changeClassNames at:changeClassNames size put:clsName.
+ NoColoring ~~ true ifTrue:[
+ changeType := changeType allItalic.
+ changeType emphasisAllAdd:(#color -> UserPreferences current commentColor).
+ "/ changeString := clsName allItalic.
+ ].
+ autoCompare value ifTrue:[
+ (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[
+ changeDelta := '?'
+ ] ifFalse:[
+ (changeClass comment = (p args at:1) evaluate) ifTrue:[
+ changeDelta := '='.
+ ]
+ ]
+ ].
+ sel := nil.
+ ].
+
+ (sel == #removeSelector:) ifTrue:[
+ nameAndClass := self extractClassAndClassNameFromParseTree:rec.
+ clsName := nameAndClass key. changeClass := nameAndClass value.
+
+ sel := (p args at:1) evaluate.
+ changeClassNames at:changeClassNames size put:clsName.
+
+ autoCompare value ifTrue:[
+ (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[
+ changeDelta := '?'
+ ] ifFalse:[
+ (changeClass includesSelector:sel asSymbol) ifTrue:[
+ changeDelta := '-'.
+ ] ifFalse:[
+ changeDelta := '='.
+ ]
+ ]
+ ].
+ changeType := '(remove)'.
+ changeString := self contractClass:clsName selector:sel to:maxLen.
+ sel := nil.
+ ].
+
+ (p notNil
+ and:[p ~~ #Error
+ and:[p isMessage
+ and:[rec isMessage
+ and:[rec selector == #compiledMethodAt:]]]]) ifTrue:[
+ nameAndClass := self extractClassAndClassNameFromParseTree:rec receiver.
+ clsName := nameAndClass key. changeClass := nameAndClass value.
+
+ (sel == #category:) ifTrue:[
+ sel := (rec args at:1) evaluate.
+ changeType := '(category change)'.
+ changeString := self contractClass:clsName selector:sel to:maxLen.
+ changeClassNames at:changeClassNames size put:clsName.
+ changeClass notNil ifTrue:[
+ m := changeClass compiledMethodAt:sel asSymbol.
+ m notNil ifTrue:[
+ m category = (p args at:1) evaluate ifTrue:[
+ changeDelta := '='.
+ ]
+ ]
+ ].
+ ].
+ (sel == #privacy:) ifTrue:[
+ sel := (rec args at:1) evaluate.
+ changeType := '(privacy change)'.
+ changeString := self contractClass:clsName selector:sel to:maxLen.
+ changeClassNames at:changeClassNames size put:clsName.
+ ].
+ sel := nil.
+ ].
+
+ (Class definitionSelectors includes:sel) ifTrue:[
+ changeType := '(class definition)'.
+ clsName := (p args at:1) evaluate.
+ changeClassNames at:changeClassNames size put:clsName.
+
+ "/ is it a private-class ?
+ ('*privateIn:' match:sel) ifTrue:[
+ ownerTree := p args last.
+ ownerName := ownerTree name asString.
+ clsName := ownerName , '::' , clsName
+ ].
+
+ changeString := clsName.
+ NoColoring ~~ true ifTrue:[
+ changeType := changeType allBold.
+ changeString := changeString allBold.
+ ].
+
+ autoCompare value ifTrue:[
+ cls := (self nameSpaceForApply) at:clsName asSymbol ifAbsent:nil.
+ cls isNil ifTrue:[
+ changeDelta := '+'.
+ ] ifFalse:[
+ (cls definitionSelector = sel
+ or:[
+ "/ could be an ST/V, VAge or Dolphin definition
+ cls definitionSelector = (sel , 'category:')
+ ])
+ ifTrue:[
+ ((cls superclass isNil
+ and:[p receiver isConstant
+ and:[p receiver evaluate isNil]])
+ or:[
+ cls superclass notNil
+ and:[p receiver isConstant not
+ and:[cls superclass name = p receiver name]]
+ ]) ifTrue:[
+ cls instanceVariableString asCollectionOfWords = (p args at:2) evaluate asCollectionOfWords ifTrue:[
+ cls classVariableString asCollectionOfWords = (p args at:3) evaluate asCollectionOfWords ifTrue:[
+ (p args at:4) evaluate isEmpty ifTrue:[
+ cls definitionSelector = (sel , 'category:')
+ ifTrue:[
+ "/ ST/V, VAge or Dolphin definition
+ changeDelta := '='.
+ ] ifFalse:[
+ cls category = (p args at:5) evaluate ifTrue:[
+ changeDelta := '='.
+ ] ifFalse:[
+ changeType := '(class category change)'.
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ sel := nil.
+ ] ifFalse:[
+ (#(
+ #'primitiveDefinitions:'
+ #'primitiveFunctions:'
+ #'primitiveVariables:'
+ ) includes:sel) ifTrue:[
+ changeType := '(class definition)'.
+ clsName := rec evaluate.
+ ] ifFalse:[
+ ((sel == #instanceVariableNames:)
+ and:[rec isMessage
+ and:[rec selector == #class]]) ifTrue:[
+ clsName := rec receiver name.
+ changeClass := (self nameSpaceForApply) classNamed:clsName.
+ changeType := '(class definition)'.
+ changeClassNames at:changeClassNames size put:clsName.
+
+ autoCompare value ifTrue:[
+ changeClass isNil ifTrue:[
+ changeDelta := '?'.
+ ] ifFalse:[
+ s := (p args at:1) evaluate.
+ s = changeClass class instanceVariableString ifTrue:[
+ changeDelta := '='.
+ ]
+ ]
+ ].
+ ]
+ ]
+ ].
+ ]
+ ] ifTrue:[ "sawExcla"
+ singleJunkOnly := false.
+ methodChunks := false.
+ classCategoryChunks := methodCategoryChunks := false.
+ singleInfo := false.
+
+ "
+ 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 ....
+ "
+ clsName := nil.
+ p := Parser parseExpression:chunkText inNameSpace:(self nameSpaceForApply).
+
+ (p notNil and:[p ~~ #Error]) ifTrue:[
+ rec := p receiver.
+ sel := p selector.
+ (#(
+ #methodsFor:
+ #privateMethodsFor:
+ #publicMethodsFor:
+ #ignoredMethodsFor:
+ #protectedMethodsFor:
+ #methodsFor:stamp: "/ Squeak support
+ #'commentStamp:prior:' "/ Squeak support
+ #methodsFor "/ Dolphin support
+ #categoriesForClass "/ Dolphin support
+ #categoriesFor: "/ Dolphin support
+ #methods "/ STV support
+ #publicMethods "/ STV support
+ #methodsForUndefined:
+ )
+ includes:sel) ifTrue:[
+ methodChunks := true.
+ nameAndClass := self extractClassAndClassNameFromParseTree:rec.
+ clsName := nameAndClass key. changeClass := nameAndClass value.
+
+ sel == #categoriesForClass ifTrue:[
+ methodChunks := false.
+ classCategoryChunks := true.
+ changeType := '(class category change)'.
+ ] ifFalse:[
+ sel == #categoriesFor: ifTrue:[
+ methodChunks := false.
+ methodCategoryChunks := true.
+ changeType := '(category change)'.
+ methodSelector := (p args at:1) evaluate.
+ ] ifFalse:[
+ (sel == #'methodsFor') ifTrue:[
+ category := 'Dolphin methods'.
+ ] ifFalse:[
+ ((sel == #methods) or:[sel == #publicMethods]) ifTrue:[
+ category := 'STV methods'.
+ ] ifFalse:[
+ category := (p args at:1) evaluate.
+ ]
+ ].
+ ].
+ ].
+
+ sel == #'methodsFor:stamp:' ifTrue:[
+ "/ Squeak timeStamp
+ timeStampInfo := (p args at:2) evaluate.
+ singleInfo := true
+ ] ifFalse:[
+ sel == #'commentStamp:prior:' ifTrue:[
+ singleJunkOnly := true.
+ methodChunks := false.
+ ]
+ ]
+ ] ifFalse:[
+ sel == #reorganize ifTrue:[
+ singleJunkOnly := true.
+ methodChunks := false.
+ ]
+ ].
+ ].
+
+ done := false.
+ first := true.
+ [done] whileFalse:[
+ changeDelta := ' '.
+ methodPos := inStream position1Based.
+
+ text := inStream nextChunk.
+ done := text isEmptyOrNil.
+
+ done ifFalse:[
+ first ifFalse:[
+ changeChunks add:chunkText.
+ changeClassNames add:clsName.
+ changePositions add:methodPos.
+ changeTimeStamps add:timeStampInfo.
+ changeIsFollowupMethodChange add:true.
+ askedForEditingClassSource ifFalse:[
+ thisIsAClassSource := (changeFileName asFilename hasSuffix:'st').
+ askedForEditingClassSource := true.
+ ]
+ ] ifTrue:[
+ changeClassNames at:changeClassNames size put:clsName.
+ ].
+
+ first := false.
+
+ (classCategoryChunks or:[methodCategoryChunks]) ifTrue:[
+ text := text asCollectionOfLines first asString.
+ classCategoryChunks ifTrue:[
+ changeClass isNil ifTrue:[
+ changeDelta := '?'.
+ ] ifFalse:[
+ changeClass category = text ifTrue:[
+ changeDelta := '='.
+ ]
+ ].
+ changeString := clsName , ' category: ' , text storeString.
+ ]ifFalse:[
+ changeString := '(' , clsName , ' compiledMethodAt:' , methodSelector storeString , ') category: ' , text storeString.
+ ].
+ ] ifFalse:[
+ "
+ try to find the selector
+ "
+ methodSelector := nil.
+ clsName notNil ifTrue:[
+ methodChunks ifTrue:[
+ p := Parser
+ parseMethodSpecification:text
+ in:nil
+ ignoreErrors:true
+ ignoreWarnings:true.
+ (p notNil and:[p ~~ #Error]) ifTrue:[
+ methodSelector := p selector.
+ ]
+ ]
+ ].
+
+ methodSelector isNil ifTrue:[
+ changeString := (chunkText contractTo:maxLen).
+ changeType := '(change)'.
+ headerLine := chunkText , ' (change)'.
+ ] ifFalse:[
+ changeString := self contractClass:clsName selector:methodSelector to:maxLen.
+ changeType := '{ ' , category , ' }'.
+ headerLine := clsName , ' ' , methodSelector , ' ' , '(change category: ''' , category , ''')'.
+ ].
+
+ autoCompare value ifTrue:[
+ changeClass isNil ifFalse:[
+ cls := changeClass theNonMetaclass
+ ].
+
+ (changeClass isNil or:[methodSelector isNil or:[cls isLoaded not]]) ifTrue:[
+ changeClass isNil ifTrue:[
+ changeDelta := '+'
+ ] ifFalse:[
+ changeDelta := '?'
+ ]
+ ] ifFalse:[
+ (changeClass includesSelector:methodSelector asSymbol) ifFalse:[
+ changeDelta := '+'.
+ ] ifTrue:[
+ m := changeClass compiledMethodAt:methodSelector asSymbol.
+ currentText := m source.
+ currentText notNil ifTrue:[
+ text asString string withoutTrailingSeparators = currentText asString string withoutTrailingSeparators ifTrue:[
+ changeDelta := '='
+ ] ifFalse:[
+ t1 := currentText asCollectionOfLines collect:[:s | s withTabsExpanded].
+ t2 := text asCollectionOfLines collect:[:s | s withTabsExpanded].
+ t1 = t2 ifTrue:[
+ changeDelta := '='
+ ] ifFalse:[
+ |tree1 tree2|
+
+ RBParser notNil ifTrue:[
+ tree1 := RBParser parseMethod:currentText onError:[:aString :pos | ^ nil].
+ tree2 := RBParser parseMethod:text onError:[:aString :pos | ^ nil].
+
+ tree1 = tree2 ifTrue:[
+ changeDelta := '~'
+ ].
+ ].
+ ].
+ ]
+ ]
+ ]
+ ]
+ ].
+ ].
+ self addHeaderLineForChangeType:changeType changeString:changeString changeDelta:changeDelta timeStampInfo:timeStampInfo.
+ ].
+ changeString := nil.
+ headerLine := nil.
+ singleJunkOnly ifTrue:[done := true]
+ ].
+ singleInfo ifTrue:[
+ timeStampInfo := nil
+ ].
+ ].
+ changeString notNil ifTrue:[
+ self addHeaderLineForChangeType:changeType changeString:changeString changeDelta:changeDelta timeStampInfo:timeStampInfo.
+ ] ifFalse:[
+ headerLine notNil ifTrue:[
+ changeHeaderLines add:headerLine
+ ]
+ ]
+ ]
+!
+
+readChangesFile
+ "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 the same as current methods source
+ '~' -> change is almost the 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."
+
+ |excla|
+
+ changeChunks := OrderedCollection new.
+ changeClassNames := OrderedCollection new.
+ changeHeaderLines := OrderedCollection new.
+ changePositions := OrderedCollection new.
+ changeTimeStamps := OrderedCollection new.
+ changeIsFollowupMethodChange := OrderedCollection new.
+
+ excla := inStream class chunkSeparator.
+
+ [inStream atEnd] whileFalse:[
+ "
+ get a chunk (separated by excla)
+ "
+ inStream skipSeparators.
+ chunkPosition := inStream position1Based.
+
+ sawExcla := inStream peekFor:excla.
+ chunkText := fullChunkText := inStream nextChunk.
+ chunkText notNil ifTrue:[
+ self processChunk.
+ ]
+ ].
+
+ "Modified: / 27.8.1995 / 23:06:55 / claus"
+ "Modified: / 9.11.2001 / 02:24:46 / cg"
+! !
+
!ChangesBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.338 2006-01-17 12:18:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.339 2006-01-31 22:11:06 cg Exp $'
! !