Attached is a change set which fixes the display of (old) code in the
ChangeSorter, the DualChangeSorter and  -by inheritance- the
ChangeSetBrowser (called by CTL-B on the chandesorter menu). As well,
one can file out the actual contents of a Changeset. It does not fix the
message set browser called by CTL-b.

A note on implementation: the original implementation seemed to use
setContents to set contents;) and selectedMethod to respond to changed.
A override selectedMethod gets the real code. It is inserted into
setContents at the proper spot.

ChangeSorter was on the steppingList, courtesy of the codeHolder. It was
scanning for any possible change of the source of a method. That does
not make sense if we are trying to keep the old code: stepping code made
vacuous.

The way I tested this was as follows: before filing in the attached
change set, I created a change set called OldChangeset. I put the
ChangeSet class and ChangeSorter into this and filed it out. I then
looked at the ChangeSorterFixes with the File Contents Browser (lovely
tool that!) and filed it in. A dual change sorter then lets you look at
methods on both sides; I did not figure out how to diff them.

Finally, I considered making this effort a ChangeSorter subclass,
something like ImmutableChangeSorter. The problem is that I had to touch
other classes, i.e. ChangeSet, because ChangeSorter delegates some
copying and fileOut there.

Try it and tell me if an obvious angle was missed. Perhaps that is why
Roel Wuyts developed his SystemChangeNotification after what he called
"visiting the dark sides of Squeak";)




On Fri, 2004-01-23 at 05:43, C. David Shaffer wrote:
> Doug Way wrote:
> 
> >
> > It would be interesting to "fix" the ChangeSorters so that they show 
> > the original source from the changesets.  It is true though that 
> > everyone has gotten used to the ChangeSorters showing the current 
> > code, so there would have to be some getting used to the new behavior.
> >
> > - Doug
> 
> 
> No, at least not everyone :-)  I would love to see the suggested change 
> to the ChangeSorters.
> 
> -- 
> C. David Shaffer
> http://www.shaffer-consulting.com
> 
> 
> 

-------------- next part --------------
'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 31 January 2004 at 12:13:34 pm'!

!ChangeSet methodsFor: '*CSFixes' stamp: 'gms 1/26/2004 13:16'!
compiledMethodAtReference: methodReference

	|classCgh methChg meth| 
	classCgh _ self changeRecords at: methodReference actualClass name ifAbsent:[^nil].
	methChg _ classCgh methodChanges at: methodReference methodSymbol ifAbsent:[^nil].
	methChg hasBeenRemoved ifTrue:[^nil].
	meth _ methChg currentMethod.
	meth ifNil:[^nil].
	^meth
! !

!ChangeSet methodsFor: 'fileIn/Out' stamp: 'gms 1/23/2004 11:39'!
fileOutChangesFor: class on: stream 
	"Write out all the method changes for this class."

	| changes |
	changes _ Set new.
	(self methodChangesAtClass: class name) associationsDo: 
		[:mAssoc | (mAssoc value = #remove or: [mAssoc value = #addedThenRemoved])
			ifFalse: [changes add: mAssoc key]].
	self fileOutChangedMessages: changes for: class on: stream .! !

!ChangeSet methodsFor: 'moving changes' stamp: 'gms 1/21/2004 11:13'!
absorbMethod: selector class: aClass from: aChangeSet 

	"Absorb a copy into the receiver all the changes for the method in the 
	class in the other change set."

	(self changeRecorderFor: aClass) methodChanges 
		at: selector 
		put: ((aChangeSet changeRecords at: aClass name) methodChanges at: selector) copy! !

!ChangeSet methodsFor: '*CSFixes' stamp: 'gms 1/23/2004 09:02'!
sourceCodeAtReference: methodReference

	|temp|
	temp _ self compiledMethodAtReference: methodReference.
	temp ifNil: [^nil].
	^temp getSource! !

!ChangeSet methodsFor: 'fileIn/Out' stamp: 'gms 1/23/2004 12:40'!
fileOutChangedMessages: changes for: class on: outStream 
	"Write out all the method changes for this class."
	"Derived from ClassDescription>>printMethodChunk:withPreamble:on:moveSource:toFile:"
	"Files out the source code defined in the changeSet itself."

	| methodPreamble method oldPos sourceFile |

	changes do:[:selector|
	methodPreamble _ class name , ' methodsFor: ' ,
					(class organization categoryOfElement: selector) asString printString.
	method _ self compiledMethodAtReference: (MethodReference new setStandardClass: class  methodSymbol: selector).
	((method fileIndex = 0
		or: [(SourceFiles at: method fileIndex) == nil])
		or: [(oldPos _ method filePosition) = 0])
		ifTrue:
		["The source code is not accessible.  We must decompile..."
		methodPreamble size > 0 ifTrue: [outStream cr; nextPut: $!!; nextChunkPut: methodPreamble; cr].
		outStream nextChunkPut: (class decompilerClass new decompile: selector
											in: class method: method) decompileString]
		ifFalse:
		[sourceFile _ SourceFiles at: method fileIndex.
		sourceFile position: oldPos.
		methodPreamble size > 0 ifTrue:    "Copy the methodPreamble"
			[outStream copyPreamble: methodPreamble from: sourceFile].
		outStream copyMethodChunkFrom: sourceFile.
		sourceFile skipSeparators.      "The following chunk may have style"
		sourceFile peek == $] ifTrue: [
			outStream cr; copyMethodChunkFrom: sourceFile]].
	methodPreamble size > 0 ifTrue: [outStream nextChunkPut: ' '].
	outStream cr.].

	outStream cr.
! !

!ChangeSet methodsFor: 'accessing' stamp: 'gms 1/20/2004 13:49'!
changeRecords
	^changeRecords! !

!ChangeSet methodsFor: 'accessing' stamp: 'gms 1/20/2004 13:49'!
changeRecords: anObject
	changeRecords := anObject! !


!ClassChangeRecord methodsFor: 'all changes' stamp: 'gms 1/27/2004 09:12'!
assimilateAllChangesIn: otherRecord

	| selector changeRecord changeType |
	otherRecord isClassRemoval ifTrue: [^ self noteChangeType: #remove].

	otherRecord allChangeTypes do:
		[:chg | self noteChangeType: chg fromClass: self realClass].

	otherRecord methodChanges associationsDo:
		[:assn | selector _ assn key. changeRecord _ assn value.
		changeType _ changeRecord changeType.
		(changeType == #remove or: [changeType == #addedThenRemoved])
			ifTrue:
				[changeType == #addedThenRemoved
					ifTrue: [self methodChanges at: selector  put: changeRecord copy.
							self atSelector: selector put: #add].
				self noteRemoveSelector: selector priorMethod: nil
						lastMethodInfo: changeRecord methodInfoFromRemoval]
			ifFalse: 
				[self methodChanges at: selector  put: changeRecord copy]].
! !


!CodeHolder methodsFor: 'annotation' stamp: 'gms 1/20/2004 18:30'!
annotationForSelector: aSelector ofClass: aClass 
	"Provide a line of content for an annotation pane, representing  
	information about the given selector and class"
	| stamp sendersCount implementorsCount aCategory separator aString aList aComment aStream requestList isLoaded |
	aSelector == #Comment
		ifTrue: [^ self annotationForClassCommentFor: aClass].
	aSelector == #Definition
		ifTrue: [^ self annotationForClassDefinitionFor: aClass].
	aSelector == #Hierarchy
		ifTrue: [^ self annotationForHierarchyFor: aClass].
	aStream _ ReadWriteStream on: ''.
	requestList _ self annotationRequests.
	separator _ requestList size > 1
				ifTrue: [self annotationSeparator]
				ifFalse: [''].
	requestList
		do: [:aRequest | 
			aRequest == #firstComment
				ifTrue: [aComment _ aClass firstCommentAt: aSelector.
					aComment isEmptyOrNil
						ifFalse: [aStream nextPutAll: aComment , separator]].
			aRequest == #masterComment
				ifTrue: [aComment _ aClass supermostPrecodeCommentFor: aSelector.
					aComment isEmptyOrNil
						ifFalse: [aStream nextPutAll: aComment , separator]].
			aRequest == #documentation
				ifTrue: [aComment _ aClass precodeCommentOrInheritedCommentFor: aSelector.
					aComment isEmptyOrNil
						ifFalse: [aStream nextPutAll: aComment , separator]].
			aRequest == #timeStamp
				ifTrue: [stamp _ self timeStamp.
					isLoaded _ self isCurrentlyLoaded ifTrue:['*', separator] ifFalse:[''].
					aStream
						nextPutAll: (stamp size > 0
								ifTrue: [isLoaded, stamp , separator]
								ifFalse: [isLoaded, 'no timeStamp' , separator])].
			aRequest == #messageCategory
				ifTrue: [aCategory _ aClass organization categoryOfElement: aSelector.
					aCategory
						ifNotNil: ["woud be nil for a method no longer present,  
							e.g. in a recent-submissions browser"
							aStream nextPutAll: aCategory , separator]].
			aRequest == #sendersCount
				ifTrue: [sendersCount _ (self systemNavigation allCallsOn: aSelector) size.
					sendersCount _ sendersCount == 1
								ifTrue: ['1 sender']
								ifFalse: [sendersCount printString , ' senders'].
					aStream nextPutAll: sendersCount , separator].
			aRequest == #implementorsCount
				ifTrue: [implementorsCount _ self systemNavigation numberOfImplementorsOf: aSelector.
					implementorsCount _ implementorsCount == 1
								ifTrue: ['1 implementor']
								ifFalse: [implementorsCount printString , ' implementors'].
					aStream nextPutAll: implementorsCount , separator].
			aRequest == #priorVersionsCount
				ifTrue: [self
						addPriorVersionsCountForSelector: aSelector
						ofClass: aClass
						to: aStream].
			aRequest == #priorTimeStamp
				ifTrue: [stamp _ VersionsBrowser
								timeStampFor: aSelector
								class: aClass
								reverseOrdinal: 2.
					stamp
						ifNotNil: [aStream nextPutAll: 'prior time stamp: ' , stamp , separator]].
			aRequest == #recentChangeSet
				ifTrue: [aString _ ChangeSorter mostRecentChangeSetWithChangeForClass: aClass selector: aSelector.
					aString size > 0
						ifTrue: [aStream nextPutAll: aString , separator]].
			aRequest == #allChangeSets
				ifTrue: [aList _ ChangeSorter allChangeSetsWithClass: aClass selector: aSelector.
					aList size > 0
						ifTrue: [aList size = 1
								ifTrue: [aStream nextPutAll: 'only in change set ']
								ifFalse: [aStream nextPutAll: 'in change sets: '].
							aList
								do: [:aChangeSet | aStream nextPutAll: aChangeSet name , ' ']]
						ifFalse: [aStream nextPutAll: 'in no change set'].
					aStream nextPutAll: separator]].
	^ aStream contents! !

!CodeHolder methodsFor: '*CSFixes' stamp: 'gms 1/26/2004 15:19'!
isCurrentlyLoaded
	"Is the method referred to by the selection currently loaded into the image?"
	| class selector methodRef methodInImage|

	class _ self selectedClassOrMetaClass.
	(class isNil or: [(selector _ self selectedMessageName) isNil]) ifTrue: [^ false].
	methodRef _ MethodReference new setStandardClass: class  methodSymbol: selector.
	methodInImage _ methodRef asCompiledMethod.
	methodInImage ifNil:[^false].
	currentCompiledMethod ifNil:[^false].
	^currentCompiledMethod == methodInImage! !


!ChangeSorter methodsFor: 'changeSet menu' stamp: 'gms 1/27/2004 09:36'!
fileOutMessage
	"Put a description of the selected message on a file"

	| aClass selector nameBody fileStream |
	self selectedMessageName ifNotNil:
	[Cursor write showWhile:
	[
	aClass _ self selectedClassOrMetaClass. 
	selector _self selectedMessageName.
	(selector == #Comment) ifTrue: [^ self inform: 'Sorry, cannot file out class comment in isolation.'].
	(aClass includesSelector: selector) ifFalse: [^ self error: 'Selector ', selector asString, ' not found'].
	nameBody _ aClass name , '-' , (selector copyReplaceAll: ':' with: '').
	fileStream _ FileStream newFileNamed: nameBody , '.st'.
	fileStream header; timeStamp.
	myChangeSet fileOutChangedMessages: {selector} for: aClass on: fileStream.
	fileStream close]]! !

!ChangeSorter methodsFor: 'as yet unclassified' stamp: 'gms 1/31/2004 07:25'!
wantsStepsIn: aWindow
	^ false! !

!ChangeSorter methodsFor: 'code pane' stamp: 'gms 1/31/2004 08:43'!
setContents
	"return the source code that shows in the bottom pane"

	| sel class strm changeType |
	self clearUserEditFlag.
	currentClassName ifNil: [^ contents _ myChangeSet preambleString ifNil: ['']].
	class _ self selectedClassOrMetaClass.
	(sel _ currentSelector) == nil
		ifFalse: [changeType _ (myChangeSet atSelector: (sel _ sel asSymbol) class: class).
			changeType == #remove
				ifTrue: [^ contents _ 'Method has been removed (see versions)'].
			changeType == #addedThenRemoved
				ifTrue: [^ contents _ 'Added then removed (see versions)'].
			class ifNil: [^ contents _ 'Method was added, but cannot be found!!'].
			(class includesSelector: sel)
				ifFalse: [^ contents _ 'Method was added, but cannot be found!!'].
			"contents _ class sourceCodeAt: sel.  this is the source currently in the image"
			contents _ self selectedMessage.
			(#(prettyPrint colorPrint prettyDiffs altSyntax) includes: contentsSymbol) ifTrue:
				[contents _ class compilerClass new
					format: contents in: class notifying: nil contentsSymbol: contentsSymbol].
			self showingAnyKindOfDiffs
				ifTrue: [contents _ self diffFromPriorSourceFor: contents].
			^ contents _ contents asText makeSelectorBoldIn: class]
		ifTrue: [strm _ WriteStream on: (String new: 100).
			(myChangeSet classChangeAt: currentClassName) do:
				[:each |
				each = #remove ifTrue: [strm nextPutAll: 'Entire class was removed.'; cr].
				each = #addedThenRemoved ifTrue: [strm nextPutAll: 'Class was added then removed.'].
				each = #rename ifTrue: [strm nextPutAll: 'Class name was changed.'; cr].
				each = #add ifTrue: [strm nextPutAll: 'Class definition was added.'; cr].
				each = #change ifTrue: [strm nextPutAll: 'Class definition was changed.'; cr].
				each = #reorganize ifTrue: [strm nextPutAll: 'Class organization was changed.'; cr].
				each = #comment ifTrue: [strm nextPutAll: 'New class comment.'; cr.
				]].
			^ contents _ strm contents].! !

!ChangeSorter methodsFor: 'annotation' stamp: 'gms 1/20/2004 17:38'!
timeStamp

	currentCompiledMethod ifNil:[^''].
	^currentCompiledMethod timeStamp asString! !

!ChangeSorter methodsFor: 'code pane' stamp: 'gms 1/31/2004 07:29'!
stepIn: aSystemWindow
	! !

!ChangeSorter methodsFor: 'message list' stamp: 'gms 1/31/2004 08:41'!
selectedMessage


	| class selector methodRef |
	
	class _ self selectedClassOrMetaClass.
	(class isNil or: [(selector _ self selectedMessageName) isNil]) ifTrue: [^ ''].
	methodRef _ MethodReference new setStandardClass: class  methodSymbol: selector.
	currentCompiledMethod _ myChangeSet compiledMethodAtReference: methodRef.


	currentCompiledMethod ifNil:[^''].				
	contents _ myChangeSet sourceCodeAtReference: methodRef.
	contents ifNil:[^''].
	^contents _ contents copy asText makeSelectorBoldIn: class.! !


!MethodChangeRecord methodsFor: 'as yet unclassified' stamp: 'gms 1/23/2004 09:09'!
hasBeenRemoved

	^ (changeType == #remove or: [changeType == #addedThenRemoved])! !


!MethodReference methodsFor: '*CSFixes' stamp: 'gms 1/20/2004 18:16'!
asCompiledMethod

	^self actualClass compiledMethodAt: self methodSymbol ifAbsent: [nil]! !


!MethodReference reorganize!
('queries' actualClass asStringOrText classIsMeta classSymbol isValid methodSymbol printOn:)
('setting' setClass:methodSymbol:stringVersion: setClassAndSelectorIn: setClassSymbol:classIsMeta:methodSymbol:stringVersion: setStandardClass:methodSymbol:)
('string version' stringVersion stringVersion:)
('comparisons' <= =)
('*packageinfo')
('*packageinfo-base' category sourceCode)
('*CSFixes' asCompiledMethod)
('*ma base additions' maActualMethod)
('*RA-modification' hash)
!


!CodeHolder reorganize!
('annotation' addOptionalAnnotationsTo:at:plus: addPriorVersionsCountForSelector:ofClass:to: annotation annotationForClassCommentFor: annotationForClassDefinitionFor: annotationForHierarchyFor: annotationForSelector:ofClass: annotationPaneMenu:shifted: annotationRequests annotationSeparator defaultAnnotationPaneHeight defaultButtonPaneHeight)
('categories' categoryOfCurrentMethod changeCategory methodCategoryChanged selectedMessageCategoryName)
('contents' commentContents contents contentsChanged contentsSymbol contentsSymbol:)
('commands' abbreviatedWordingFor: adoptMessageInCurrentChangeset browseImplementors browseSenders copyUpOrCopyDown makeSampleInstance offerMenu offerShiftedClassListMenu offerUnshiftedClassListMenu removeClass shiftedYellowButtonActivity showUnreferencedClassVars showUnreferencedInstVars spawnFullProtocol spawnProtocol spawnToCollidingClass: unshiftedYellowButtonActivity)
('construction' addLowerPanesTo:at:with: buildMorphicCodePaneWith:)
('controls' addOptionalButtonsTo:at:plus: buttonWithSelector: codePaneProvenanceButton codePaneProvenanceString contentsSymbolQuints decorateButtons decorateForInheritance inheritanceButton optionalButtonPairs optionalButtonRow sourceAndDiffsQuintsOnly)
('diffs' defaultDiffsSymbol diffButton diffFromPriorSourceFor: prettyDiffButton regularDiffButton restoreTextualCodingPane showDiffs showDiffs: showPrettyDiffs: showRegularDiffs: showingAnyKindOfDiffs showingDiffsString showingPrettyDiffs showingPrettyDiffsString showingRegularDiffs showingRegularDiffsString toggleColorPrint toggleDiff toggleDiffing togglePlainSource togglePrettyDiffing togglePrettyPrint toggleRegularDiffing wantsDiffFeedback)
('misc' getSelectorAndSendQuery:to: getSelectorAndSendQuery:to:with: isThereAnOverride isThisAnOverride menuButton modelWakeUpIn: okayToAccept priorSourceOrNil refreshAnnotation refusesToAcceptCode releaseCachedState sampleInstanceOfSelectedClass sendQuery:to: setClassAndSelectorIn: suggestCategoryToSpawnedBrowser: useSelector:orGetSelectorAndSendQuery:to:)
('self-updating' didCodeChangeElsewhere stepIn: updateCodePaneIfNeeded updateListsAndCodeIn: wantsStepsIn:)
('what to show' addContentsTogglesTo: colorPrintString offerWhatToShowMenu prettyPrintString setContentsToForceRefetch showAltSyntax: showByteCodes: showComment showDecompile: showDocumentation: showingAltSyntax showingAltSyntaxString showingByteCodes showingByteCodesString showingColorPrint showingDecompile showingDecompileString showingDocumentation showingDocumentationString showingPlainSource showingPlainSourceString showingPrettyPrint showingSource toggleAltSyntax toggleDecompile toggleShowDocumentation toggleShowingByteCodes)
('tiles' addModelItemsToWindowMenu: installTextualCodingPane installTilesForSelection showTiles: showingTiles showingTilesString toggleShowingTiles)
('categories & search pane' listPaneWithSelector: newSearchPane searchPane textPaneWithSelector:)
('message list' decompiledSourceIntoContents selectedBytecodes selectedMessage sourceStringPrettifiedAndDiffed validateMessageSource:forSelector:)
('message list menu' messageListKey:from:)
('message category functions' canShowMultipleMessageCategories)
('*Refactory-RBExternalBrowserReferences' buildClassBrowserEditString: spawn: spawnHierarchy spawnToClass:)
('*CSFixes' isCurrentlyLoaded)
!