--- a/ChangesBrowser.st Sun Jan 27 17:27:52 2008 +0100
+++ b/ChangesBrowser.st Sun Jan 27 18:11:10 2008 +0100
@@ -1637,7 +1637,7 @@
].
].
- selector == #'category:' ifTrue:[
+ (#(#'category:' #'package:') includes:selector) ifTrue:[
receiver isMessage ifTrue:[
receiver selector == #compiledMethodAt: ifTrue:[
classGlobalNode := receiver receiver.
@@ -1648,13 +1648,19 @@
^ 'Class does not exist.'.
].
Error handle:[method := nil] do:[method := receiver evaluate].
- method isMethod ifTrue:[
+ method isMethod ifFalse:[
+ ^ 'There is no such method'.
+ ].
+ selector == #category: ifTrue:[
method category = parseTree arg1 evaluate ifFalse:[
- ^ '(' , method class name , ' compiledMethodAt: ' , method selector storeString , ') category: ' , method category storeString.
- ]
+ ^ '(' , method mclass name , ' compiledMethodAt: ' , method selector storeString , ') category: ' , method category storeString.
+ ].
] ifFalse:[
- ^ 'There is no such method'.
- ]
+ method package = parseTree arg1 evaluate ifFalse:[
+ ^ '(' , method mclass name , ' compiledMethodAt: ' , method selector storeString , ') package: ' , method package storeString.
+ ].
+ ].
+ ^ nil
]
]
].
@@ -1989,13 +1995,13 @@
"
name := changeClassNames at:changeNr.
name notNil ifTrue:[
- name == #nil ifTrue:[^ nil].
- ^ name
+ name == #nil ifTrue:[^ nil].
+ ^ name
].
prevMethodDefNr := changeNr.
[changeIsFollowupMethodChange at:prevMethodDefNr] whileTrue:[
- prevMethodDefNr := prevMethodDefNr - 1.
+ prevMethodDefNr := prevMethodDefNr - 1.
].
"
@@ -2005,24 +2011,24 @@
chunk isNil ifTrue:[^ nil]. "mhmh - empty"
(chunk startsWith:'''---') ifTrue:[
- words := chunk asCollectionOfWords.
- words size > 2 ifTrue:[
- (words at:2) = 'checkin' ifTrue:[
- name := words at:3.
- ^ name
- ]
- ].
+ words := chunk asCollectionOfWords.
+ words size > 2 ifTrue:[
+ (words at:2) = 'checkin' ifTrue:[
+ name := words at:3.
+ ^ name
+ ]
+ ].
].
"/ fix it - otherwise, it cannot be parsed
(chunk endsWith:'primitiveDefinitions:') ifTrue:[
- chunk := chunk , ''''''
+ chunk := chunk , ''''''
].
(chunk endsWith:'primitiveFunctions:') ifTrue:[
- chunk := chunk , ''''''
+ chunk := chunk , ''''''
].
(chunk endsWith:'primitiveVariables:') ifTrue:[
- chunk := chunk , ''''''
+ chunk := chunk , ''''''
].
"
@@ -2030,26 +2036,26 @@
"
oldDollarSetting := Parser allowDollarInIdentifier.
[
- Parser allowDollarInIdentifier:true.
+ Parser allowDollarInIdentifier:true.
"/ Class nameSpaceQuerySignal answer:(self nameSpaceForApply)
"/ do:[
- aParseTree := Parser parseExpression:chunk.
+ aParseTree := Parser parseExpression:chunk.
"/ ].
- aParseTree == #Error ifTrue:[
- (chunk includesString:'comment') ifTrue:[
- "/ could be a comment ...
- aParseTree := Parser parseExpression:chunk , ''''.
- ]
- ].
+ aParseTree == #Error ifTrue:[
+ (chunk includesString:'comment') ifTrue:[
+ "/ could be a comment ...
+ aParseTree := Parser parseExpression:chunk , ''''.
+ ]
+ ].
] ensure:[
- Parser allowDollarInIdentifier:oldDollarSetting
+ Parser allowDollarInIdentifier:oldDollarSetting
].
(aParseTree isNil or:[aParseTree == #Error]) ifTrue:[
- ^ nil "seems strange ... (could be a comment)"
+ ^ nil "seems strange ... (could be a comment)"
].
aParseTree isMessage ifFalse:[
- ^ nil "very strange ... (whats that ?)"
+ ^ nil "very strange ... (whats that ?)"
].
"
@@ -2083,27 +2089,27 @@
#categoriesFor: "/ Dolphin support
#methods "/ STV support
) includes:sel) ifTrue:[
- "
- yes, the className is the receiver
- "
- (recTree notNil and:[recTree ~~ #Error]) ifTrue:[
- isMeta := false.
- recTree isUnaryMessage ifTrue:[
- (recTree selector ~~ #class) ifTrue:[^ nil].
- "id class methodsFor:..."
- recTree := recTree receiver.
- isMeta := true.
- ].
- recTree isPrimary ifTrue:[
- name := recTree name.
- isMeta ifTrue:[
- name := name , ' class'.
- ].
- ^ name
- ]
- ].
- "more strange things"
- ^ nil
+ "
+ yes, the className is the receiver
+ "
+ (recTree notNil and:[recTree ~~ #Error]) ifTrue:[
+ isMeta := false.
+ recTree isUnaryMessage ifTrue:[
+ (recTree selector ~~ #class) ifTrue:[^ nil].
+ "id class methodsFor:..."
+ recTree := recTree receiver.
+ isMeta := true.
+ ].
+ recTree isPrimary ifTrue:[
+ name := recTree name.
+ isMeta ifTrue:[
+ name := name , ' class'.
+ ].
+ ^ name
+ ]
+ ].
+ "more strange things"
+ ^ nil
].
"
@@ -2112,84 +2118,85 @@
(('subclass:*' match:sel)
or:[('variable*ubclass:*' match:sel)]) ifTrue:[
- "/ must parse the full changes text, to get
- "/ privacy information.
-
- changeStream := self streamForChange:changeNr.
- changeStream notNil ifTrue:[
- chunk := changeStream nextChunk.
- changeStream close.
- fullParseTree := Parser parseExpression:chunk.
- (fullParseTree isNil or:[fullParseTree == #Error]) ifTrue:[
- fullParseTree := nil
- ] ifFalse:[
- fullParseTree isMessage ifFalse:[
- fullParseTree := nil
- ]
- ].
- "/ actually, the nil case cannot happen
- fullParseTree notNil ifTrue:[
- aParseTree := fullParseTree.
- sel := aParseTree selector.
- ].
- ].
-
- arg1Tree := aParseTree arg1.
- (arg1Tree notNil and:[arg1Tree isConstant]) ifTrue:[
- name := arg1Tree value asString.
-
- "/ is it a private-class ?
- ('*privateIn:' match:sel) ifTrue:[
- ownerTree := aParseTree args last.
- ownerName := ownerTree name asString.
- name := ownerName , '::' , name
- ].
- ^ name
- ].
- "very strange"
- ^ nil
+ "/ must parse the full changes text, to get
+ "/ privacy information.
+
+ changeStream := self streamForChange:changeNr.
+ changeStream notNil ifTrue:[
+ chunk := changeStream nextChunk.
+ changeStream close.
+ fullParseTree := Parser parseExpression:chunk.
+ (fullParseTree isNil or:[fullParseTree == #Error]) ifTrue:[
+ fullParseTree := nil
+ ] ifFalse:[
+ fullParseTree isMessage ifFalse:[
+ fullParseTree := nil
+ ]
+ ].
+ "/ actually, the nil case cannot happen
+ fullParseTree notNil ifTrue:[
+ aParseTree := fullParseTree.
+ sel := aParseTree selector.
+ ].
+ ].
+
+ arg1Tree := aParseTree arg1.
+ (arg1Tree notNil and:[arg1Tree isConstant]) ifTrue:[
+ name := arg1Tree value asString.
+
+ "/ is it a private-class ?
+ ('*privateIn:' match:sel) ifTrue:[
+ ownerTree := aParseTree args last.
+ ownerName := ownerTree name asString.
+ name := ownerName , '::' , 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.
- ^ name
- ].
- ]
+ (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.
+ ^ name
+ ].
+ ]
].
"
is it a method category change ?
"
((sel == #category:)
- or:[sel == #privacy:]) ifTrue:[
- (recTree notNil
- and:[recTree ~~ #Error
- and:[recTree isMessage
- and:[recTree selector == #compiledMethodAt:]]]) ifTrue:[
- isMeta := false.
- recTree := recTree receiver.
- recTree isUnaryMessage ifTrue:[
- (recTree selector ~~ #class) ifTrue:[^ nil].
- "id class "
- recTree := recTree receiver
- ].
- recTree isPrimary ifTrue:[
- isMeta ifTrue:[
- name := name , ' class'.
- ].
- name := recTree name.
- ^ name
- ]
- ]
+ or:[sel == #package:
+ or:[sel == #privacy:]]) ifTrue:[
+ (recTree notNil
+ and:[recTree ~~ #Error
+ and:[recTree isMessage
+ and:[recTree selector == #compiledMethodAt:]]]) ifTrue:[
+ isMeta := false.
+ recTree := recTree receiver.
+ recTree isUnaryMessage ifTrue:[
+ (recTree selector ~~ #class) ifTrue:[^ nil].
+ "id class "
+ recTree := recTree receiver
+ ].
+ recTree isPrimary ifTrue:[
+ isMeta ifTrue:[
+ name := name , ' class'.
+ ].
+ name := recTree name.
+ ^ name
+ ]
+ ]
].
^ nil
@@ -2807,6 +2814,27 @@
"Modified: / 20-11-2006 / 13:15:48 / cg"
!
+compareCategoryChange:parseTree
+ |receiverExpression method|
+
+ receiverExpression := parseTree receiver.
+ receiverExpression isMessage ifTrue:[
+ receiverExpression selector == #compiledMethodAt: ifTrue:[
+ (receiverExpression receiver evaluate isBehavior
+ and:[(method := receiverExpression evaluate) isMethod]) ifTrue:[
+ method category = parseTree arg1 evaluate ifTrue:[
+ ^ true -> 'Change has no effect\\(same category)'.
+ ] ifFalse:[
+ ^ false -> 'Category is different (''' , method category , ''' vs. ''' , parseTree arg1 evaluate , ''')'.
+ ]
+ ] ifFalse:[
+ ^ nil -> 'There is no such method'.
+ ]
+ ]
+ ].
+ ^ nil -> 'Unhandled receiver'
+!
+
compareChange:changeNr
"compare a change with the current (in-image) version; show the result of the compare (as dialog)"
@@ -2819,9 +2847,8 @@
If doShowResult is true, the outcome is shown in a dialog/diffViewer."
|aStream chunk sawExcla parseTree thisClass cat oldSource newSource
- parser sel oldMethod outcome showDiff d t1 t2 selector isLoaded
- method beep superClass thisClassSym varsHere varsInChange addedVars removedVars
- isSame ownerClass superClassHere superClassInChange|
+ parser sel oldMethod outcome showDiff d t1 t2 selector isLoaded beep superClass thisClassSym varsHere varsInChange addedVars removedVars
+ isSame ownerClass superClassHere superClassInChange sameAndOutcome |
aStream := self streamForChange:changeNr.
aStream isNil ifTrue:[^ nil].
@@ -2850,86 +2877,30 @@
selector := parseTree selector.
selector == #'removeSelector:' ifTrue:[
- thisClass := (parseTree receiver evaluate).
- thisClass isBehavior ifTrue:[
- (self checkClassIsLoaded:thisClass) ifTrue:[
- selector := (parseTree arg1 evaluate).
- (thisClass includesSelector:selector) ifTrue:[
- outcome := 'Change removes the #' , selector , ' method from ' , thisClass name.
- isSame := false.
- ] ifFalse:[
- outcome := 'Change has no effect\\(there is no method for #' , selector , ' in ' , thisClass name , ')'.
- isSame := true.
- ]
- ] ifFalse:[
- beep := true.
- outcome := 'Cannot compare this change (compare requires class to be loaded).'.
- isSame := nil.
- ]
- ] ifFalse:[
- outcome := 'Cannot compare this change (class not present)'.
- isSame := nil.
- ].
+ sameAndOutcome := self compareRemoveSelectorChange:parseTree.
+ isSame := sameAndOutcome key.
+ outcome := sameAndOutcome value.
+ ].
+ selector == #'package:' ifTrue:[
+ sameAndOutcome := self comparePackageChange:parseTree.
+ isSame := sameAndOutcome key.
+ outcome := sameAndOutcome value.
].
selector == #'category:' ifTrue:[
- parseTree receiver isMessage ifTrue:[
- parseTree receiver selector == #compiledMethodAt: ifTrue:[
- |receiver|
- receiver := parseTree receiver.
- (receiver receiver evaluate isBehavior
- and:[(method := receiver evaluate) isMethod]) ifTrue:[
- method category = parseTree arg1 evaluate ifTrue:[
- outcome := 'Change has no effect\\(same category)'.
- isSame := true.
- ] ifFalse:[
- outcome := 'Category is different (''' , method category , ''' vs. ''' , parseTree arg1 evaluate , ''')'.
- isSame := false.
- ]
- ] ifFalse:[
- beep := true.
- outcome := 'There is no such method'.
- isSame := nil.
- ]
- ]
- ]
+ sameAndOutcome := self compareCategoryChange:parseTree.
+ isSame := sameAndOutcome key.
+ outcome := sameAndOutcome value.
].
selector == #'comment:' ifTrue:[
- thisClass := (parseTree receiver evaluate).
- thisClass isBehavior ifTrue:[
- (self checkClassIsLoaded:thisClass) ifTrue:[
- (thisClass comment = parseTree arg1 evaluate) ifTrue:[
- outcome := 'Change has no effect\\(same comment)'.
- isSame := true.
- ] ifFalse:[
- outcome := 'Comment is different'.
- isSame := false.
- ]
- ] ifFalse:[
- beep := true.
- outcome := 'Cannot compare this change (compare requires class to be loaded).'.
- isSame := nil.
- ]
- ] ifFalse:[
- outcome := 'Cannot compare this change (class not present)'.
- isSame := nil.
- ].
+ sameAndOutcome := self compareCommentChange:parseTree.
+ isSame := sameAndOutcome key.
+ outcome := sameAndOutcome value.
].
selector == #'instanceVariableNames:' ifTrue:[
- parseTree receiver isMessage ifTrue:[
- parseTree receiver selector == #class ifTrue:[
- thisClass := (parseTree receiver evaluate).
- varsHere := thisClass instanceVariableString asCollectionOfWords.
- varsInChange := (parseTree arguments at:1) evaluate asCollectionOfWords.
- varsHere = varsInChange ifTrue:[
- outcome := 'Change has no effect\\(same definition)'.
- isSame := true.
- ] ifFalse:[
- outcome := 'Class-instanceVariable definition is different'.
- isSame := false.
- ].
- ].
- ]
+ sameAndOutcome := self compareInstanceVariableNamesChange:parseTree.
+ isSame := sameAndOutcome key.
+ outcome := sameAndOutcome value.
].
(Class definitionSelectors includes:selector)
@@ -3181,6 +3152,83 @@
"Modified: / 13.2.2000 / 15:04:39 / cg"
!
+compareCommentChange:parseTree
+ |thisClass|
+
+ thisClass := (parseTree receiver evaluate).
+ thisClass isBehavior ifTrue:[
+ (self checkClassIsLoaded:thisClass) ifTrue:[
+ (thisClass comment = parseTree arg1 evaluate) ifTrue:[
+ ^ true -> 'Change has no effect\\(same comment)'.
+ ] ifFalse:[
+ ^ false -> 'Comment is different'.
+ ]
+ ] ifFalse:[
+ ^ nil -> 'Cannot compare this change (compare requires class to be loaded).'.
+ ]
+ ].
+ ^ nil -> 'Cannot compare this change (class not present)'.
+!
+
+compareInstanceVariableNamesChange:parseTree
+ |receiverExpression thisClass varsHere varsInChange |
+
+ receiverExpression := parseTree receiver.
+ receiverExpression isMessage ifTrue:[
+ receiverExpression selector == #class ifTrue:[
+ thisClass := (receiverExpression evaluate).
+ varsHere := thisClass instanceVariableString asCollectionOfWords.
+ varsInChange := (parseTree arguments at:1) evaluate asCollectionOfWords.
+ varsHere = varsInChange ifTrue:[
+ ^ true -> 'Change has no effect\\(same definition)'.
+ ] ifFalse:[
+ ^ false -> 'Class-instanceVariable definition is different'.
+ ].
+ ].
+ ].
+ ^ nil -> 'Unhandled receiver'
+!
+
+comparePackageChange:parseTree
+ |receiverExpression method|
+
+ receiverExpression := parseTree receiver.
+ receiverExpression isMessage ifTrue:[
+ receiverExpression selector == #compiledMethodAt: ifTrue:[
+ (receiverExpression receiver evaluate isBehavior
+ and:[(method := receiverExpression evaluate) isMethod]) ifTrue:[
+ method package = parseTree arg1 evaluate ifTrue:[
+ ^ true -> 'Change has no effect\\(same package)'.
+ ] ifFalse:[
+ ^ false -> 'Package is different (''' , method package , ''' vs. ''' , parseTree arg1 evaluate , ''')'.
+ ]
+ ] ifFalse:[
+ ^ nil -> 'There is no such method'.
+ ]
+ ]
+ ].
+ ^ nil -> 'Unhandled receiver'
+!
+
+compareRemoveSelectorChange:parseTree
+ |thisClass selector|
+
+ thisClass := (parseTree receiver evaluate).
+ thisClass isBehavior ifTrue:[
+ (self checkClassIsLoaded:thisClass) ifTrue:[
+ selector := (parseTree arg1 evaluate).
+ (thisClass includesSelector:selector) ifTrue:[
+ ^ false -> 'Change removes the #' , selector , ' method from ' , thisClass name.
+ ] ifFalse:[
+ ^ true -> 'Change has no effect\\(there is no method for #' , selector , ' in ' , thisClass name , ')'.
+ ]
+ ] ifFalse:[
+ ^ nil -> 'Cannot compare this change (compare requires class to be loaded).'.
+ ]
+ ].
+ ^ nil -> 'Cannot compare this change (class not present)'.
+!
+
compressForClass:aClassNameOrNil
"compress the change-set;
this replaces multiple method-changes by the last (i.e. the most recent) change.
@@ -5940,5 +5988,5 @@
!ChangesBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.372 2007-04-04 16:27:28 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.373 2008-01-27 17:11:10 cg Exp $'
! !