'From Cuis 1.0 of 6 March 2009 [latest update: #5989] on 6 March 2009 at 2:46:37 pm'!

!ChangeList methodsFor: 'menu actions' stamp: 'jmv 3/5/2009 15:29'!
changeListMenu: aMenu
	"Fill aMenu up so that it comprises the primary changelist-browser menu"

	aMenu addTitle: 'change list'.
		aMenu addStayUpItemSpecial.

	aMenu addList: #(

	('fileIn selections'							fileInSelections						'import the selected items into the image')
	('fileOut selections...	'						fileOutSelections						'create a new file containing the selected items')
	-
	('compare to current'						compareToCurrentVersion			'open a separate window which shows the text differences between the on-file version and the in-image version.' )
	('toggle diffing (D)'							toggleDiffing						'start or stop showing diffs in the code pane.')
	-
	('select conflicts with any changeset'		selectAllConflicts					'select methods in the file which also occur in any change-set in the system')
	('select conflicts with current changeset'	selectConflicts						'select methods in the file which also occur in the current change-set')
	('select conflicts with...'						selectConflictsWith					'allows you to designate a file or change-set against which to check for code conflicts.')
	-
	('select unchanged methods'					selectUnchangedMethods				'select methods in the file whose in-image versions are the same as their in-file counterparts' )
	('select methods equivalent to current'		selectEquivalentMethods				'select methods in the file whose in-image versions have the same behavior as their in-file counterparts' )
	('select new methods'						selectNewMethods					'select methods in the file that do not current occur in the image')
	('select methods for this class'				selectMethodsForThisClass			'select all methods in the file that belong to the currently-selected class')

	-
	('select all (a)'								selectAll								'select all the items in the list')
	('deselect all'								deselectAll							'deselect all the items in the list')
	('invert selections'							invertSelections						'select every item that is not currently selected, and deselect every item that *is* currently selected')
	-
	('browse all versions of single selection'			browseVersions		'open a version browser showing the versions of the currently selected method')
	('browse all versions of selections'			browseAllVersionsOfSelections		'open a version browser showing all the versions of all the selected methods')
	('browse current versions of selections'		browseCurrentVersionsOfSelections	'open a message-list browser showing the current (in-image) counterparts of the selected methods')
	('destroy current methods of selections'		destroyCurrentCodeOfSelections		'remove (*destroy*) the in-image counterparts of all selected methods')
	-
	('remove doIts'								removeDoIts							'remove all items that are doIts rather than methods')
	('remove older versions'						removeOlderMethodVersions			'remove all but the most recent versions of methods in the list')
	('remove up-to-date versions'				removeExistingMethodVersions		'remove all items whose code is the same as the counterpart in-image code')
	('remove empty class comments'				removeEmptyClassComments		'remove all empty class comments')
	('remove selected items'						removeSelections					'remove the selected items from the change-list')
	('remove unselected items'					removeNonSelections					'remove all the items not currently selected from the change-list')).

	^ aMenu

! !

!ChangeList methodsFor: 'menu actions' stamp: 'jmv 3/6/2009 09:53'!
removeDoIts
	"Remove doits from the receiver, other than initializes. 1/26/96 sw"

	| newChangeList newList |
Cursor wait showWhile: [
	newChangeList _ OrderedCollection new.
	newList _ OrderedCollection new.

	changeList with: list do:
		[:chRec :str |
			(chRec type ~~ #doIt or:
				[str endsWith: 'initialize'])
					ifTrue:
						[newChangeList add: chRec.
						newList add: str]].
	newChangeList size < changeList size
		ifTrue:
			[changeList _ newChangeList.
			list _ newList.
			listIndex _ 0.
			listSelections _ Array new: list size withAll: false].
].
	self changed: #list.

	! !

!ChangeList methodsFor: 'menu actions' stamp: 'jmv 3/6/2009 09:53'!
removeEmptyClassComments
	| newChangeList newList keep name |
	newChangeList _ OrderedCollection new.
	newList _ OrderedCollection new.
Cursor wait showWhile: [
	changeList with: list do: [ :chRec :strNstamp | 
			keep _ true.
			(chRec type == #classComment and: [
					name _ chRec methodClassName.
					Smalltalk includesKey: name]) ifTrue: [
				keep _ chRec text notEmpty
			].
			keep ifTrue:[
				newChangeList add: chRec.
				newList add: strNstamp]].
	newChangeList size < changeList size
		ifTrue: [
			changeList _ newChangeList.
			list _ newList.
			listIndex _ 0.
			listSelections _ Array new: list size withAll: false].
].
	self changed: #list! !

!ChangeList methodsFor: 'menu actions' stamp: 'jmv 3/6/2009 09:52'!
removeExistingMethodVersions
	"Remove all up to date version of entries from the receiver"
	"Modified to also remove up to date classDefinitions and classComments"
	| newChangeList newList str keep cls sel name |
Cursor wait showWhile: [
	newChangeList _ OrderedCollection new.
	newList _ OrderedCollection new.

	changeList with: list do: [ :chRec :strNstamp | 
			keep _ true.
			(cls _ chRec methodClass) ifNotNil:[
				str _ chRec string.
				sel _ cls parserClass new parseSelector: str.
				keep _ (cls sourceCodeAt: sel ifAbsent:['']) asString ~= str.
			].
			(chRec type == #classComment and: [
					name _ chRec methodClassName.
					Smalltalk includesKey: name]) ifTrue: [
				cls _ Smalltalk at: name.
				keep _ cls organization classComment ~= chRec text.
			].
			(chRec type == #classDefinition and: [
					name _ chRec methodClassName.
					Smalltalk includesKey: name]) ifTrue: [
				cls _ Smalltalk at: name.
				chRec isMetaClassChange ifTrue: [ cls _ cls class ].
				keep _ cls definition ~= chRec text.
			].
			keep ifTrue:[
				newChangeList add: chRec.
				newList add: strNstamp]].
	newChangeList size < changeList size
		ifTrue: [
			changeList _ newChangeList.
			list _ newList.
			listIndex _ 0.
			listSelections _ Array new: list size withAll: false].
].
	self changed: #list! !

!ChangeList methodsFor: 'menu actions' stamp: 'jmv 3/6/2009 09:56'!
removeOlderMethodVersions
	"Remove older versions of entries from the receiver."
	| newChangeList newList found str |
	newChangeList _ OrderedCollection new.
	newList _ OrderedCollection new.
	found _ OrderedCollection new.
Cursor wait showWhile: [
	changeList reverseWith: list do:
		[:chRec :strNstamp | str _ strNstamp copyUpTo: $;.
			(found includes: str)
				ifFalse:
					[found add: str.
					newChangeList add: chRec.
					newList add: strNstamp]].
	newChangeList size < changeList size
		ifTrue:
			[changeList _ newChangeList reversed.
			list _ newList reversed.
			listIndex _ 0.
			listSelections _ Array new: list size withAll: false].
].
	self changed: #list! !

!ChangeList methodsFor: 'menu actions' stamp: 'jmv 3/6/2009 13:04'!
selectEquivalentMethods
	"Selects all method definitions for which there is already an equivalent method in the current image, 
	(meaning that the difference is cosmetic and not in behavior)"
	| change class cmWithNode current inChange currentCmWithNode |
	Cursor wait showWhile: [
		1 to: changeList size do: [ :i | 
			change _ changeList at: i.
			listSelections at: i put:
				((change type = #method and: [
					(class _ change methodClass) notNil]) and: [
						(class includesSelector: change methodSelector) and: [
							cmWithNode _ [class basicCompile: change string notifying: nil trailer: class defaultMethodTrailer ifFail: [nil]] 
								on: SyntaxErrorNotification do: [ :ex | ex return ].
							(cmWithNode notNil and: [
								current _ (class compiledMethodAt: change methodSelector) copyWithTrailerBytes: #(0).
								inChange _cmWithNode method copyWithTrailerBytes: #(0).
								current = inChange or: [
									currentCmWithNode _ [class basicCompile: (class decompilerClass new decompile: change methodSelector in: class) decompileString
											notifying: nil trailer: class defaultMethodTrailer ifFail: [nil]] on: SyntaxErrorNotification do: [ :ex | ex return ].
									(currentCmWithNode notNil and: [
										current _ currentCmWithNode method copyWithTrailerBytes: #(0).
										current = inChange])
								]
							])
						]]
				)]].
	self changed: #allSelections! !


!SystemOrganizer methodsFor: 'fileIn/Out' stamp: 'jmv 3/5/2009 10:22'!
fileOutAllCategories
	"
	Cursor write showWhile: [
		SystemOrganization fileOutAllCategories ]
	"
	| fileStream imName |
	imName _ FileDirectory baseNameFor:
		(FileDirectory localNameFor: Smalltalk imageName).
	fileStream _ FileStream newFileNamed: imName, '-AllCode', FileDirectory dot, 'st'.
	[
		self categories do: [ :category |
			self fileOutCategoryNoPoolsNoInit: category on: fileStream]
	] ensure: [ fileStream close ]! !

!SystemOrganizer methodsFor: 'fileIn/Out' stamp: 'jmv 3/5/2009 10:16'!
fileOutCategoryNoPoolsNoInit: category on: aFileStream
	"Store on the file associated with aFileStream, all the classes associated 
	with the category and any requested shared pools."

	| first classes |
	classes _ self superclassOrder: category.
	first _ true.
	classes do: [ :class | 
		first
			ifTrue: [first _ false]
			ifFalse: [aFileStream cr; nextPut: Character newPage; cr].
		class
			fileOutOn: aFileStream
			moveSource: false
			toFile: 0
			initializing: false]! !

