--- a/SourceCodeManagerUtilities.st Tue Mar 14 16:07:54 2017 +0100
+++ b/SourceCodeManagerUtilities.st Fri Mar 17 18:45:39 2017 +0100
@@ -670,12 +670,215 @@
!
goodInitialLogMessageForCheckinClassOfClass:aClass
-
- <resource: #obsolete>
-
- self obsoleteMethodWarning: 'Please use instance protocol (SourceCodeManagerUtilities default doSomething)'.
-
- ^self default goodInitialLogMessageForCheckinClassOfClass:aClass
+ "figure out, if there were any non-comment changes.
+ Provide a reasonable initial log message (I am tired of typing in 'comment only').
+ This is a q&d hack - not complete and not correct (for example, it will generate a method change
+ info line, even if the selector was removed afterwards).
+ So check the outcome."
+
+
+ "/ a helper function
+ |printSelectors initialLogStream additionalInfoPerChangedSelector changesForThisCheckin changesPerClass|
+
+ printSelectors :=
+ [:what :selectors :more |
+ |sel moreInfo|
+
+ selectors remove:nil ifAbsent:[].
+ initialLogStream nextPutAll:(what,':').
+ selectors size < 15 ifTrue:[
+ selectors size == 1 ifTrue:[
+ sel := selectors first.
+ initialLogStream nextPutAll: ' #'; nextPutAll:sel.
+ more ifTrue:[
+ (moreInfo := additionalInfoPerChangedSelector at:sel ifAbsent:nil) notNil ifTrue:[
+ initialLogStream space; nextPutAll:moreInfo.
+ ]
+ ].
+ initialLogStream cr.
+ ] ifFalse:[
+ initialLogStream cr.
+ selectors asSortedCollection do:[:sel |
+ initialLogStream tab; nextPutAll:'#'; nextPutAll:sel.
+ more ifTrue:[
+ (moreInfo := additionalInfoPerChangedSelector at:sel ifAbsent:nil) notNil ifTrue:[
+ initialLogStream space; nextPutAll:moreInfo.
+ ].
+ ].
+ initialLogStream cr
+ ].
+ ].
+ ] ifFalse:[
+ initialLogStream
+ print: (selectors size); nextPutAll: ' methods'; cr.
+ ].
+ ].
+
+ changesForThisCheckin := ChangeSet current
+ select:[:aChange |
+ |changeClass|
+
+ aChange isClassChange and:[
+ changeClass := aChange changeClass theNonMetaclass.
+ changeClass == aClass or:[changeClass topOwningClass == aClass]
+ ].
+ ].
+
+ changesForThisCheckin sort:[:a :b| a className < b className].
+ changesPerClass := changesForThisCheckin asCollectionOfSubCollectionsSeparatedByAnyChange:[:prev :curr| prev className ~= curr className].
+
+ initialLogStream := '' writeStream.
+
+ changesPerClass do:[:changesForThisClass|
+ |selectorsInChangeSet newSelectors modifiedSelectors definitionChangesForThisClass methodChangesForThisClass
+ allMethodChangesForThisClass modifiedMethodsForThisClass newMethodsForThisClass removedMethodsForThisClass
+ selectorsWithCommentOrFormattingChangeOnly
+ selectorsWithVariableChangeOnly newSelectorsRemoved
+ removedSelectors categoryChanges categoryChangeSelectors|
+
+ additionalInfoPerChangedSelector := Dictionary new.
+ definitionChangesForThisClass := changesForThisClass reject:[:aChange | aChange isMethodChange].
+ categoryChanges := changesForThisClass select:[:aChange | aChange isMethodCategoryChange].
+ categoryChangeSelectors := categoryChanges collect:[:aChange | aChange changeSelector] as:Set.
+ allMethodChangesForThisClass := changesForThisClass select:[:aChange | aChange isMethodCodeChange].
+ selectorsInChangeSet := allMethodChangesForThisClass collect:[:aChange | aChange changeSelector] as:Set.
+ methodChangesForThisClass := selectorsInChangeSet collect:[:eachSelector |
+ allMethodChangesForThisClass detectLast:[:change | change changeSelector = eachSelector]] as:OrderedCollection.
+
+ modifiedMethodsForThisClass := methodChangesForThisClass
+ select:[:aChange | aChange previousVersion notNil].
+ modifiedSelectors := modifiedMethodsForThisClass collect:[:aChange | aChange changeSelector] as:Set.
+
+ newMethodsForThisClass := allMethodChangesForThisClass
+ select:[:aChange | aChange previousVersion isNil].
+ newSelectors := newMethodsForThisClass collect:[:aChange | aChange changeSelector] as:Set.
+
+ removedMethodsForThisClass := changesForThisClass
+ select:[:aChange | aChange isMethodRemoveChange and:[ aChange changeMethod isNil ]].
+ removedSelectors := removedMethodsForThisClass collect:[:aChange | aChange changeSelector] as:Set.
+
+ "/ get rid of category changes for new and removed methods
+ categoryChanges := categoryChanges reject:[:chg |
+ |methodWithChangedCat|
+
+ (methodWithChangedCat := chg changeMethod) isNil
+ or:[ newMethodsForThisClass contains:[:newChg | newChg changeMethod = methodWithChangedCat]]].
+
+ initialLogStream nextPutLine:'class: ', changesForThisClass first className.
+
+ "/ definition?
+ "/ suppress definition-message if initial checkin
+ (aClass package isNil or:[aClass revision isNil]) ifFalse:[
+ definitionChangesForThisClass notEmpty ifTrue:[
+ "/ self halt.
+ initialLogStream nextPutLine:'class definition'.
+ ].
+ ].
+
+ "/ added selectors?
+ newSelectorsRemoved := newSelectors select:[:sel | removedSelectors includes:sel].
+
+ newSelectors removeAllFoundIn:removedSelectors.
+ newSelectors notEmpty ifTrue:[
+ printSelectors value:'added' value:newSelectors value:false.
+ ].
+ modifiedSelectors removeAllFoundIn:newSelectors.
+ categoryChangeSelectors removeAllFoundIn:newSelectors.
+
+ "/ removed selectors?
+ removedSelectors removeAllFoundIn:newSelectorsRemoved.
+ removedSelectors notEmpty ifTrue:[
+ printSelectors value:'removed' value:removedSelectors value:false.
+ ].
+ modifiedSelectors removeAllFoundIn:removedSelectors.
+ categoryChangeSelectors removeAllFoundIn:removedSelectors.
+
+ "/ modifications?
+ modifiedSelectors notEmpty ifTrue:[
+ selectorsWithCommentOrFormattingChangeOnly := Set new.
+ selectorsWithVariableChangeOnly := Set new.
+
+ "/ check for format/comment change
+ RBParser notNil ifTrue:[
+ modifiedSelectors do:[:eachSelector |
+ |oldest newest oldMethod newMethod oldTree newTree
+ variableMapping selectorMapping unchangedVariables unchangedSelectors|
+
+ (newSelectors includes:eachSelector) ifFalse:[
+ oldest := allMethodChangesForThisClass detect:[:change | change changeSelector = eachSelector].
+ newest := allMethodChangesForThisClass detectLast:[:change | change changeSelector = eachSelector].
+
+ oldest := oldest previousVersion notNil ifTrue:[oldest previousVersion] ifFalse:[oldest].
+
+ oldTree := RBParser parseMethod:oldest source onError:[:aString :pos | nil].
+ newTree := RBParser parseMethod:newest source onError:[:aString :pos | nil].
+
+ (oldTree notNil and:[newTree notNil]) ifTrue:[
+ variableMapping := Dictionary new.
+ (oldTree "semanticallyEqualTo:" equalTo:newTree withMapping: variableMapping) ifTrue:[
+ unchangedVariables := variableMapping keys select:[:k | (variableMapping at:k) = k].
+ variableMapping removeAllKeys:unchangedVariables.
+
+ (variableMapping at:'self' ifAbsent:'self') = 'self' ifTrue:[
+ ((variableMapping associations count:[:assoc | assoc key ~= assoc value]) == 0) ifTrue:[
+ selectorsWithCommentOrFormattingChangeOnly add:eachSelector.
+ ] ifFalse:[
+ "/ check, if a global has changed (aka sends to another global)
+ ((variableMapping keys contains:[:var | var first isUppercase])
+ or:[ (variableMapping values contains:[:var | var first isUppercase]) ]) ifFalse:[
+ selectorsWithVariableChangeOnly add:eachSelector.
+ ].
+ ].
+ ].
+ ] ifFalse:[
+ selectorMapping := Dictionary new.
+ (oldTree equalTo:newTree withSelectorMapping: selectorMapping) ifTrue:[
+ unchangedSelectors := selectorMapping keys select:[:k | (selectorMapping at:k) = k].
+ selectorMapping removeAllKeys:unchangedSelectors.
+ (selectorMapping notEmpty and:[selectorMapping size <= 2]) ifTrue:[
+ additionalInfoPerChangedSelector at:eachSelector put:(
+ String streamContents:[:s |
+ |first|
+
+ s nextPutAll:'('.
+ first := true.
+ selectorMapping keysAndValuesDo:[:selOld :selNew |
+ first ifFalse:[s nextPutAll:', '].
+ s print:('send #',selNew,' instead of #',selOld).
+ first := false.
+ ].
+ s nextPutAll:')'.
+ ]).
+ ]
+ ]
+ ].
+ ].
+ ]
+ ].
+ ].
+
+ modifiedSelectors removeAllFoundIn:selectorsWithCommentOrFormattingChangeOnly.
+ modifiedSelectors removeAllFoundIn:selectorsWithVariableChangeOnly.
+
+ (selectorsWithCommentOrFormattingChangeOnly notEmpty) ifTrue:[
+ printSelectors value:'comment/format in' value:selectorsWithCommentOrFormattingChangeOnly value:false.
+ ].
+ (selectorsWithVariableChangeOnly notEmpty) ifTrue:[
+ printSelectors value:'variable renamed in' value:selectorsWithVariableChangeOnly value:false.
+ ].
+ (modifiedSelectors notEmpty) ifTrue:[
+ printSelectors value:'changed' value:modifiedSelectors value:true.
+ ].
+ ].
+ categoryChanges notEmpty ifTrue:[
+ printSelectors value:'category of' value:categoryChangeSelectors value:false.
+ ].
+ ] separatedBy:[
+ initialLogStream cr.
+ ].
+ ^ initialLogStream contents
+
+ "Modified: / 17-03-2017 / 18:39:28 / stefan"
! !
!SourceCodeManagerUtilities class methodsFor:'utilities-encoding'!
@@ -3836,7 +4039,7 @@
"/ heuristics for a useful initial log message...
aLogInfoOrNil isNil ifTrue:[
- initialLogMessage := (self goodInitialLogMessageForCheckinClassOfClass:aClass) ? ''.
+ initialLogMessage := (self class goodInitialLogMessageForCheckinClassOfClass:aClass) ? ''.
"/ initial checkin ?
(aClass package isNil or:[(aClass revisionOfManager:manager) "revision" isNil]) ifTrue:[
initialLogMessage := 'initial checkin\\' withCRs , initialLogMessage
@@ -3909,6 +4112,7 @@
^ true
"Modified: / 31-03-2016 / 17:58:11 / cg"
+ "Modified: / 17-03-2017 / 18:00:12 / stefan"
!
knownTagsInPackages:packages
@@ -4937,206 +5141,6 @@
"Modified: / 12-03-2012 / 13:12:40 / cg"
!
-goodInitialLogMessageForCheckinClassOfClass:aClass
- "figure out, if there were any non-comment changes.
- Provide a reasonable initial log message (I am tired of typing in 'comment only').
- This is a q&d hack - not complete and not correct (for example, it will generate a method change
- info line, even if the selector was removed afterwards).
- So check the outcome."
-
- |selectorsInChangeSet newSelectors modifiedSelectors
- className metaClassName classChanges changesForThisClass definitionChangesForThisClass methodChangesForThisClass
- allMethodChangesForThisClass modifiedMethodsForThisClass newMethodsForThisClass removedMethodsForThisClass
- initialLogStream printSelectors selectorsWithCommentOrFormattingChangeOnly
- selectorsWithVariableChangeOnly newSelectorsRemoved
- removedSelectors categoryChanges categoryChangeSelectors additionalInfoPerChangedSelector|
-
- "/ a helper function
- printSelectors :=
- [:what :selectors :more |
- |sel moreInfo|
-
- selectors remove:nil ifAbsent:[].
- initialLogStream nextPutAll:(what,':').
- selectors size < 15 ifTrue:[
- selectors size == 1 ifTrue:[
- sel := selectors first.
- initialLogStream nextPutAll: ' #'; nextPutAll:sel.
- more ifTrue:[
- (moreInfo := additionalInfoPerChangedSelector at:sel ifAbsent:nil) notNil ifTrue:[
- initialLogStream space; nextPutAll:moreInfo.
- ]
- ].
- initialLogStream cr.
- ] ifFalse:[
- initialLogStream cr.
- selectors asSortedCollection do:[:sel |
- initialLogStream tab; nextPutAll:'#'; nextPutAll:sel.
- more ifTrue:[
- (moreInfo := additionalInfoPerChangedSelector at:sel ifAbsent:nil) notNil ifTrue:[
- initialLogStream space; nextPutAll:moreInfo.
- ].
- ].
- initialLogStream cr
- ].
- ].
- ] ifFalse:[
- initialLogStream
- print: (selectors size); nextPutAll: ' methods'; cr.
- ].
- ].
-
- classChanges := ChangeSet current select:[:aChange | aChange isClassChange].
- className := aClass theNonMetaclass name.
- metaClassName := aClass theMetaclass name.
-
- changesForThisClass := classChanges
- select:[:aChange | aChange className = className
- or:[aChange className = metaClassName ]].
-
- additionalInfoPerChangedSelector := Dictionary new.
- definitionChangesForThisClass := changesForThisClass reject:[:aChange | aChange isMethodChange].
- categoryChanges := changesForThisClass select:[:aChange | aChange isMethodCategoryChange].
- categoryChangeSelectors := categoryChanges collect:[:aChange | aChange changeSelector] as:Set.
- allMethodChangesForThisClass := changesForThisClass select:[:aChange | aChange isMethodCodeChange].
- selectorsInChangeSet := allMethodChangesForThisClass collect:[:aChange | aChange changeSelector] as:Set.
- methodChangesForThisClass := selectorsInChangeSet collect:[:eachSelector |
- allMethodChangesForThisClass detectLast:[:change | change changeSelector = eachSelector]] as:OrderedCollection.
-
- modifiedMethodsForThisClass := methodChangesForThisClass
- select:[:aChange | aChange previousVersion notNil].
- modifiedSelectors := modifiedMethodsForThisClass collect:[:aChange | aChange changeSelector] as:Set.
-
- newMethodsForThisClass := allMethodChangesForThisClass
- select:[:aChange | aChange previousVersion isNil].
- newSelectors := newMethodsForThisClass collect:[:aChange | aChange changeSelector] as:Set.
-
- removedMethodsForThisClass := changesForThisClass
- select:[:aChange | aChange isMethodRemoveChange and:[ aChange changeMethod isNil ]].
- removedSelectors := removedMethodsForThisClass collect:[:aChange | aChange changeSelector] as:Set.
-
- "/ get rid of category changes for new and removed methods
- categoryChanges := categoryChanges reject:[:chg |
- |methodWithChangedCat|
-
- (methodWithChangedCat := chg changeMethod) isNil
- or:[ newMethodsForThisClass contains:[:newChg | newChg changeMethod = methodWithChangedCat]]].
-
- initialLogStream := '' writeStream.
- initialLogStream nextPutLine:'class: ', aClass name.
-
- "/ definition?
- "/ suppress definition-message if initial checkin
- (aClass package isNil or:[aClass revision isNil]) ifFalse:[
- definitionChangesForThisClass notEmpty ifTrue:[
- "/ self halt.
- initialLogStream nextPutLine:'class definition'.
- ].
- ].
-
- "/ added selectors?
- newSelectorsRemoved := newSelectors select:[:sel | removedSelectors includes:sel].
-
- newSelectors removeAllFoundIn:removedSelectors.
- newSelectors notEmpty ifTrue:[
- printSelectors value:'added' value:newSelectors value:false.
- ].
- modifiedSelectors removeAllFoundIn:newSelectors.
- categoryChangeSelectors removeAllFoundIn:newSelectors.
-
- "/ removed selectors?
- removedSelectors removeAllFoundIn:newSelectorsRemoved.
- removedSelectors notEmpty ifTrue:[
- printSelectors value:'removed' value:removedSelectors value:false.
- ].
- modifiedSelectors removeAllFoundIn:removedSelectors.
- categoryChangeSelectors removeAllFoundIn:removedSelectors.
-
- "/ modifications?
- modifiedSelectors notEmpty ifTrue:[
- selectorsWithCommentOrFormattingChangeOnly := Set new.
- selectorsWithVariableChangeOnly := Set new.
-
- "/ check for format/comment change
- RBParser notNil ifTrue:[
- modifiedSelectors do:[:eachSelector |
- |oldest newest oldMethod newMethod oldTree newTree
- variableMapping selectorMapping unchangedVariables unchangedSelectors|
-
- (newSelectors includes:eachSelector) ifFalse:[
- oldest := allMethodChangesForThisClass detect:[:change | change changeSelector = eachSelector].
- newest := allMethodChangesForThisClass detectLast:[:change | change changeSelector = eachSelector].
-
- oldest := oldest previousVersion notNil ifTrue:[oldest previousVersion] ifFalse:[oldest].
-
- oldTree := RBParser parseMethod:oldest source onError:[:aString :pos | nil].
- newTree := RBParser parseMethod:newest source onError:[:aString :pos | nil].
-
- (oldTree notNil and:[newTree notNil]) ifTrue:[
- variableMapping := Dictionary new.
- (oldTree "semanticallyEqualTo:" equalTo:newTree withMapping: variableMapping) ifTrue:[
- unchangedVariables := variableMapping keys select:[:k | (variableMapping at:k) = k].
- variableMapping removeAllKeys:unchangedVariables.
-
- (variableMapping at:'self' ifAbsent:'self') = 'self' ifTrue:[
- ((variableMapping associations count:[:assoc | assoc key ~= assoc value]) == 0) ifTrue:[
- selectorsWithCommentOrFormattingChangeOnly add:eachSelector.
- ] ifFalse:[
- "/ check, if a global has changed (aka sends to another global)
- ((variableMapping keys contains:[:var | var first isUppercase])
- or:[ (variableMapping values contains:[:var | var first isUppercase]) ]) ifFalse:[
- selectorsWithVariableChangeOnly add:eachSelector.
- ].
- ].
- ].
- ] ifFalse:[
- selectorMapping := Dictionary new.
- (oldTree equalTo:newTree withSelectorMapping: selectorMapping) ifTrue:[
- unchangedSelectors := selectorMapping keys select:[:k | (selectorMapping at:k) = k].
- selectorMapping removeAllKeys:unchangedSelectors.
- (selectorMapping notEmpty and:[selectorMapping size <= 2]) ifTrue:[
- additionalInfoPerChangedSelector at:eachSelector put:(
- String streamContents:[:s |
- |first|
-
- s nextPutAll:'('.
- first := true.
- selectorMapping keysAndValuesDo:[:selOld :selNew |
- first ifFalse:[s nextPutAll:', '].
- s print:('send #',selNew,' instead of #',selOld).
- first := false.
- ].
- s nextPutAll:')'.
- ]).
- ]
- ]
- ].
- ].
- ]
- ].
- ].
-
- modifiedSelectors removeAllFoundIn:selectorsWithCommentOrFormattingChangeOnly.
- modifiedSelectors removeAllFoundIn:selectorsWithVariableChangeOnly.
-
- (selectorsWithCommentOrFormattingChangeOnly notEmpty) ifTrue:[
- printSelectors value:'comment/format in' value:selectorsWithCommentOrFormattingChangeOnly value:false.
- ].
- (selectorsWithVariableChangeOnly notEmpty) ifTrue:[
- printSelectors value:'variable renamed in' value:selectorsWithVariableChangeOnly value:false.
- ].
- (modifiedSelectors notEmpty) ifTrue:[
- printSelectors value:'changed' value:modifiedSelectors value:true.
- ].
- ].
- categoryChanges notEmpty ifTrue:[
- printSelectors value:'category of' value:categoryChangeSelectors value:false.
- ].
- ^ initialLogStream contents
-
- "Modified: / 26-09-2012 / 18:31:38 / cg"
-!
-
revisionForSymbolicName:tag class:cls fileName:classFileName directory:packageDir module:moduleDir manager:aSourceCodeManager
"given a tag, return the corresponding revision"