[GOODIE] cumulative change set builder

Paul McDonough wnchips at yahoo.com
Fri Aug 25 01:19:31 UTC 2000


Squeakers,

This one's pretty obscure, but perhaps there's another
soul out there in the world somewhere who can actually
use it.

The attached change set introduces a 'cumulative
change set builder'.  Pick a directory in the
FileList, and then on the popup menu select
'fileOutAllChangeSets'.  This will:
  1.  prompt you for a file name
  2.  read in (but not install) _all_ of the change
sets in the directory you're looking at, where a
change set is taken to be any file ending in '.cs'
  3.  write out a single change set containing all of
the collected changes, sorted into a loadable order

Warnings:
  1.  no matter which directory you're looking at, the
resulting cumulative change set is written to
FileDirectory default
  2.  *no* sanity checking is performed whatsoever;
thus, if two change sets in the directory write the
same definition, the most recently encountered will
'win'; conflicts are not detected.

At some point soon, I'll enhance this to perform some
conflict checking.  If that one solitary soul out on
an island somewhere who's actually likely to use this
would like, I'll post that enhancement.

Ok, here 'tis.

__________________________________________________
Do You Yahoo!?
Yahoo! Mail - Free email you can access from anywhere!
http://mail.yahoo.com/
-------------- next part --------------
'From Squeak2.8 of 13 June 2000 [latest update: #2345] on 24 August 2000 at 6:09:07 pm'!
FilePackage subclass: #ChangeSetAgglomerater
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Exobox-Build Support'!

!ChangeSetAgglomerater commentStamp: 'pnm 8/24/2000 10:36' prior: 0!
This class is used to build a single change set from a collection of change sets. The change set produced should introduce classes in a loadable order. The process of building this change set should result in no lasting changes to the image that produces the compiled change set. If the referenced source change sets call out conflicting changes, these conflicts should be flagged and a report generated to the user.!

!ChangeSetAgglomerater methodsFor: 'private' stamp: 'pnm 8/24/2000 14:15'!
incorporateChangesFromFileNamed: aFileName

	| stream changes |
	[stream := FileStream concreteStream new
		open: aFileName
		forWrite: false.
	changes := (ChangeList new scanFile: stre!
am from: 0 to: stream size) changeList.
	changes
		do:
			[:each |
			self 
				perform: (each type copyWith: $:) asSymbol 
				with: each].
	] ensure: [stream close]! !

!ChangeSetAgglomerater methodsFor: 'private' stamp: 'pnm 8/24/2000 11:36'!
isClassName: aClassName definedIn: aCollectionOfPseudoclasses

	| result |
	result := aCollectionOfPseudoclasses
		detect: 
			[:each | 
			each type = #class and: [each name = aClassName]]
		ifNone: [nil].
	^result ~~ nil! !

!ChangeSetAgglomerater methodsFor: 'private' stamp: 'pnm 8/24/2000 11:17'!
isClassNameDefined: aClassName

	^Smalltalk includesKey: aClassName asSymbol! !

!ChangeSetAgglomerater methodsFor: 'private' stamp: 'pnm 8/24/2000 11:20'!
isClassNameDefinedInChanges: aClassName

	| result |
	result := classes
		detect: 
			[:each | 
			each type = #class and: [each name = aClassName]]
		ifNone: [nil].
	^result ~~ nil! !

!ChangeSetAgglomerater methodsFor: 'private' stamp: 'pnm 8/24/2000 11:35'!
reorderClasses

	| oldClas!
sOrder newClassOrder addedClasses |
	oldClassOrder := classOrder copy.
	newClassOrder := OrderedCollection new: classOrder size.
	[oldClassOrder isEmpty]
		whileFalse:
			[addedClasses := OrderedCollection new.
			oldClassOrder
				do:
					[:eachClass | 
					(self isClassNameDefined: eachClass superclassName)
						ifTrue: 
							[newClassOrder add: eachClass.
							addedClasses add: eachClass]
						ifFalse:
							[(self isClassName: eachClass superclassName definedIn: newClassOrder)
								ifTrue: 
									[newClassOrder add: eachClass.
									addedClasses add: eachClass]]].
			addedClasses do: [:eachClass | oldClassOrder remove: eachClass] ].
	classOrder := newClassOrder! !

!ChangeSetAgglomerater methodsFor: 'fileIn/fileOut' stamp: 'pnm 8/24/2000 13:42'!
fileOut
	| stream |
	[stream := FileStream newFileNamed: fullName.
	sourceSystem isEmpty ifFalse:[
		stream nextChunkPut: sourceSystem printString;cr ].
	self fileOutOn: stream.
	stream cr; cr.
	self classes do:[:!
cls|
		cls needsInitialize ifTrue:[
			stream cr; nextChunkPut: cls name,' initialize']].
	stream cr]
		ensure: [stream close].
	DeepCopier new checkVariables.
! !

!ChangeSetAgglomerater methodsFor: 'fileIn/fileOut' stamp: 'pnm 8/24/2000 17:43'!
fileOutOn: aStream

	self reorderClasses.
	classOrder do: [:cls | cls fileOutDefinitionOn: aStream].
	classes do:
		[:cls |
		cls fileOutMethodsOn: aStream.
		cls hasMetaclass ifTrue: [cls metaClass fileOutMethodsOn: aStream]].
	self fileOutDoits: aStream! !

!ChangeSetAgglomerater methodsFor: 'initialize' stamp: 'pnm 8/24/2000 10:48'!
named: aString fromFilesNamed: aCollectionOfFileNames

	self fullName: aString.
	aCollectionOfFileNames
		do:
			[:fileName |
			self incorporateChangesFromFileNamed: fileName].
	^self! !


!FileList methodsFor: 'file list menu' stamp: 'pnm 8/24/2000 14:00'!
itemsForNoFile
	^ #(
		('sort by name' 'sort by size' 'sort by date'
		'browse code files'
		'add new file' 'add new directory'
		'file out change !
sets as ...')
		(3 4 6)
		(sortByName sortBySize sortByDate
		browseFiles
		addNewFile addNewDirectory
		fileOutAllChangeSets)
		)! !

!FileList methodsFor: 'private' stamp: 'pnm 8/24/2000 16:35'!
fileOutAllChangeSets

	| newFileName fileNames thingie |
	newFileName := FillInTheBlank request: 'Enter the file name' initialAnswer: ''.
	fileNames := (directory fileNames select: [:fn | '*.cs' match: fn])
		collect: [:e | directory fullNameFor: e].
	thingie := ChangeSetAgglomerater new named: newFileName fromFilesNamed: fileNames.
	thingie fileOut! !


!PseudoClass methodsFor: 'accessing' stamp: 'pnm 8/24/2000 11:28'!
superclassName

	^self definition substrings first asSymbol! !

!PseudoClass methodsFor: 'fileIn/fileOut' stamp: 'pnm 8/24/2000 17:44'!
fileOutDefinitionOn: aStream
	self hasDefinition ifFalse:[^self].
	aStream nextChunkPut: self definition; cr.
	self hasComment
		ifTrue:
			[aStream cr.
			self organization commentRemoteStr fileOutOn: aStream]! !


More information about the Squeak-dev mailing list