Chris Muller uploaded a new version of VersionNumber to project Squeak 4.6:
http://source.squeak.org/squeak46/VersionNumber-cmm.4.mcz

==================== Summary ====================

Name: VersionNumber-cmm.4
Author: cmm
Time: 9 June 2012, 1:50:58.564 pm
UUID: 68fb1f05-d3e2-4c9b-9234-20a9bed166dc
Ancestors: VersionNumber-nice.3

Strengthen VersionNumber>>#=.

==================== Snapshot ====================

SystemOrganization addCategory: #VersionNumber!

Magnitude subclass: #VersionNumber
	instanceVariableNames: 'numbers'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'VersionNumber'!

!VersionNumber commentStamp: '<historical>' prior: 0!
I am a version number.  My representation allows me to handle an entire tree of versions.  Once created, an instance should not change (note: VersionNumbers could be canonicalized like Symbols, but are not currently).  

I am a magnitude so that you can see if one version preceeds another (only if the two versions are in the same branch).  

	'2.1' asVersion < '2.2.1' asVersion	"true"
	'2.3' asVersion < '2.2.1' asVersion	"error different branches"
	'2.3' asVersion inSameBranchAs: '2.2.1' asVersion	"false, why the previous one failed."	
	'2.1' asVersion = '2.1' asVersion		"true, obviously"

To get the next version number in the same branch:

	'2.3.4' asVersion next	"2.3.5"

To get the next version number, starting a new branch:

	'2.3.4' asVersion branchNext		"2.3.4.1"

To get the common base version of any two version numbers (useful for merging):

	'2.3.8' asVersion commonBase: '2.3.4.1' asVersion		"2.3.4"!

----- Method: VersionNumber class>>first (in category 'as yet unclassified') -----
first

	^self fromCollection: #(1)!

----- Method: VersionNumber class>>fromCollection: (in category 'as yet unclassified') -----
fromCollection: aCollection

	^self new
		initializeNumbers: aCollection;
		yourself!

----- Method: VersionNumber class>>fromString: (in category 'as yet unclassified') -----
fromString: aString

	^self fromCollection: 
		((aString findTokens: '.') collect: [:ea | ea asNumber ])
	!

----- Method: VersionNumber>>< (in category 'comparing') -----
< another 
	"Answer whether the receiver is less than the argument."

	| tmp |
	(self inSameBranchAs: another) ifFalse: 
		[^self error: 'Receiver and argument in different branches'].

	tmp := another numbers.
	(tmp size = numbers size) ifTrue:
		[1 to: numbers size do: 
			[ :in | (numbers at: in) < (tmp at: in) ifTrue: [^true]].
		^false].

	^numbers size < tmp size
!

----- Method: VersionNumber>>= (in category 'comparing') -----
= aVersion 
	self == aVersion ifTrue: [ ^ true ].
	aVersion species = self species ifFalse: [ ^ false ].
	^ numbers = aVersion numbers!

----- Method: VersionNumber>>branchNext (in category 'accessing') -----
branchNext

	^self class fromCollection: (numbers, (Array with: 1))!

----- Method: VersionNumber>>commonBase: (in category 'accessing') -----
commonBase: aVersion

	| smallNums largeNums cutoff |
	(aVersion numbers size <= numbers size) 
		ifTrue: [smallNums := aVersion numbers. largeNums := numbers] 
		ifFalse: [smallNums := numbers. largeNums := aVersion numbers].

	cutoff := (1 to: smallNums size) 
		detect: [ :in | ((smallNums at: in) ~= (largeNums at: in))] 
		ifNone: [^self class fromCollection: smallNums].

	^self class fromCollection: 
		((numbers copyFrom: 1 to: (cutoff - 1)), 
		(Array with: ((smallNums at: cutoff) min: (largeNums at: cutoff))))
!

----- Method: VersionNumber>>hash (in category 'comparing') -----
hash

	^numbers hash!

----- Method: VersionNumber>>inSameBranchAs: (in category 'testing') -----
inSameBranchAs: aVersion

	| less more |
	(aVersion numbers size <= numbers size) 
		ifTrue: [less := aVersion numbers. more := numbers] 
		ifFalse: [less := numbers. more := aVersion numbers].

	1 to: (less size - 1) do: [ :in | ((less at: in) = (more at: in)) ifFalse: [^false]].
	^less size = more size or:
		[(less at: less size) <= (more at: less size)]
!

----- Method: VersionNumber>>initializeNumbers: (in category 'initialization') -----
initializeNumbers: aCollection

	aCollection do: [ :ea | 
		ea <= 0 ifTrue: 
			[^self error: 'VersionNumbers cannot contain zero or negative numbers']].

	numbers := aCollection asArray!

----- Method: VersionNumber>>next (in category 'accessing') -----
next

	| tmp |
	tmp := numbers copy.
	tmp at: numbers size put: (numbers last + 1).
	^self class fromCollection: tmp!

----- Method: VersionNumber>>numbers (in category 'accessing') -----
numbers
	"Answer a copy (to discourage people from directly changing a version number).
	VersionNumbers should never change, instead, instantiate a new instance."

	^numbers copy!

----- Method: VersionNumber>>previous (in category 'accessing') -----
previous

	| tmp |
	numbers last = 1 ifTrue: 
		[^self class fromCollection: (numbers allButLast)].
	tmp := numbers copy.
	tmp at: numbers size put: (numbers last - 1).
	^self class fromCollection: tmp
!

----- Method: VersionNumber>>printOn: (in category 'printing') -----
printOn: strm

	self storeOn: strm!

----- Method: VersionNumber>>storeOn: (in category 'printing') -----
storeOn: strm

	strm nextPut: $'.
	self versionStringOn: strm.
	strm nextPutAll: ''' asVersion'.!

----- Method: VersionNumber>>versionString (in category 'printing') -----
versionString

	^String streamContents: [ :strm | self versionStringOn: strm ]!

----- Method: VersionNumber>>versionStringOn: (in category 'printing') -----
versionStringOn: strm

	| first |
	first := true.
	numbers do: [ :ea |
		first ifFalse: [strm nextPut: $.].
		first := false.
		ea printOn: strm]
	!

Object subclass: #VersionHistory
	instanceVariableNames: 'versions'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'VersionNumber'!

!VersionHistory commentStamp: '<historical>' prior: 0!
I am a version history.  A version history is a collection of VersionNumbers that together form a tree of versions.  I enforce rules about how versions are added and removed from the history.

To add a new version to a VersionHistory based on an existing version:

  VersionHistory startingAt1 addNewVersionBasedOn: '1' asVersion; yourself

If you add 2 new versions based on the same version, a branch will be started:

  VersionHistory startingAt1 
		addNewVersionBasedOn: '1' asVersion;
		addNewVersionBasedOn: '1' asVersion; 
		yourself

To remove a single version (note: only versions at the tip of a branch, or at the base of the trunk (if it has only one successor) can be individually removed):

  VersionHistory startingAt1 
		addNewVersionBasedOn: '1' asVersion;
		addNewVersionBasedOn: '1' asVersion; 
		remove: '1.1' asVersion;
		yourself

To remove an entire branch:

  VersionHistory startingAt1 
		addNewVersionBasedOn: '1' asVersion;
		addNewVersionBasedOn: '1' asVersion; 
		addNewVersionBasedOn: '1.1' asVersion; 
		addNewVersionBasedOn: '1.2' asVersion; 
		removeBranch: '1.1' asVersion;
		yourself

To remove a portion of the trunk:

  VersionHistory startingAt1 
		addNewVersionBasedOn: '1' asVersion;
		addNewVersionBasedOn: '2' asVersion; 
		addNewVersionBasedOn: '3' asVersion; 
		addNewVersionBasedOn: '3' asVersion; 
		removeTrunk: '2' asVersion;
		yourself

To get a string description of a version history:

  VersionHistory startingAt1 
		addNewVersionBasedOn: '1' asVersion;
		addNewVersionBasedOn: '2' asVersion; 
		addNewVersionBasedOn: '3' asVersion; 
		addNewVersionBasedOn: '3' asVersion; 
		treeString

Also, the following methods are useful for accessing the versions:

	#firstVersion
	#versionBefore:
	#versionsAfter:
	#mainLineStartingAt:
	#allVersionsAfter:
	#allVersionsBefore:
!

----- Method: VersionHistory class>>startingAt1 (in category 'as yet unclassified') -----
startingAt1

	^self startingAt: '1' asVersion!

----- Method: VersionHistory class>>startingAt: (in category 'as yet unclassified') -----
startingAt: aVersion

	^self new
		initializeVersionsAt: aVersion;
		yourself!

----- Method: VersionHistory>>addNewVersionBasedOn: (in category 'adding') -----
addNewVersionBasedOn: aVersion

	| tmp |
	(versions includes: aVersion) ifFalse: [^self error: 'Version is not in this history'].

	tmp := aVersion next.
	(versions includes: tmp) ifFalse: 
		[versions add: tmp.
		^tmp].

	tmp := aVersion.
	[versions includes: (tmp := tmp branchNext)] whileTrue.
	versions add: tmp.
	^tmp
	!

----- Method: VersionHistory>>allVersionsAfter: (in category 'accessing') -----
allVersionsAfter: aVersion
	"Answer all the versions based on aVersion."

	| answer |
	answer := Set new.
	versions do: [ :ea |
		((ea inSameBranchAs: aVersion) and: 
			[ea > aVersion]) ifTrue: [answer add: ea]].
	^answer!

----- Method: VersionHistory>>allVersionsBefore: (in category 'accessing') -----
allVersionsBefore: aVersion
	"Answer all versions that came before aVersion"

	| answer |
	answer := Set new.
	versions do: [ :ea |
		((ea inSameBranchAs: aVersion) and: 
			[ea < aVersion]) ifTrue: [answer add: ea]].
	^answer!

----- Method: VersionHistory>>canRemove: (in category 'testing') -----
canRemove: aVersion

	| hasPriors followers |
	(versions includes: aVersion) ifFalse: [^false].
	hasPriors := (self versionBefore: aVersion) notNil.
	followers := self versionsAfter: aVersion.		

	"Don't allow versions in the middle to be extracted"
	(hasPriors and: [followers size > 0]) ifTrue: [^false].
	
	"Don't allow versions with more than one follower to be extracted"
	(hasPriors not and: [followers size > 1]) ifTrue: [^false].
	^true

!

----- Method: VersionHistory>>firstVersion (in category 'accessing') -----
firstVersion
	"Answer the first version in the entire version history"

	^versions inject: versions anyOne into: [ :x :ea |
		(x inSameBranchAs: ea)
			ifTrue: [(x < ea) ifTrue: [x] ifFalse: [ea]]
			ifFalse: [ea]]!

----- Method: VersionHistory>>includesVersion: (in category 'testing') -----
includesVersion: aVersion

	^versions includes: aVersion!

----- Method: VersionHistory>>initializeVersionsAt: (in category 'initialization') -----
initializeVersionsAt: aVersion

	versions := Set new.
	versions add: aVersion.!

----- Method: VersionHistory>>mainLineStartingAt: (in category 'accessing') -----
mainLineStartingAt: aVersion
	"Answer all versions based on aVersion that are not branches (they have 
	the same number of digits with the same values, except the last value is
	greater than the last value of aVersion)."

	| answer tmp |
	answer := OrderedCollection new.
	tmp := aVersion.
	[versions includes: tmp] 
		whileTrue: 
			[answer add: tmp.
			tmp := tmp next].
	^answer
!

----- Method: VersionHistory>>remove: (in category 'removing') -----
remove: aVersion
	"Remove aVersion from this version history."

	^self remove: aVersion ifAbsent: [self error: 'version not found'].!

----- Method: VersionHistory>>remove:ifAbsent: (in category 'removing') -----
remove: aVersion ifAbsent: aBlock
	"Remove aVersion from this version history."

	(versions includes: aVersion) ifFalse: [^aBlock value].

	(self canRemove: aVersion) ifFalse:
		[^self error: 'Only versions at the beginning or end with no more than one follower may be removed'].

	versions remove: aVersion.!

----- Method: VersionHistory>>removeBranch: (in category 'removing') -----
removeBranch: aVersion
	"Remove aVersion and all of it's successors, providing that
	aVersion is not the first version."

	(self versionBefore: aVersion)
		ifNil: [^self error: 'version is the first version in the history'].

	versions removeAll: (self allVersionsAfter: aVersion).
	versions remove: aVersion.!

----- Method: VersionHistory>>removeTrunk: (in category 'removing') -----
removeTrunk: aVersion
	"Remove aVersion and all of it's predecessors, providing there
	are no other branches stemming from the trunk.  Note, a trunk is defined
	as all versions, starting with the first version, that have only one successor."

	| tmp |
	(self versionsAfter: aVersion) size > 1 
		ifTrue: [^self error: 'version is at a fork'].

	tmp := self allVersionsBefore: aVersion.
	(tmp anySatisfy: [ :ea | (self versionsAfter: ea) size > 1 ])
		ifTrue: [^self error: 'not a trunk, other branches detected'].

	versions removeAll: tmp.
	versions remove: aVersion.!

----- Method: VersionHistory>>treeString (in category 'printing') -----
treeString
	"Answer a string that show the entire version history with
	each branch starting on a new line"

	^self treeStringStartingAt: self firstVersion!

----- Method: VersionHistory>>treeStringOn:startingAt: (in category 'printing') -----
treeStringOn: strm startingAt: aVersion

	| tmp |
	tmp := self mainLineStartingAt: aVersion.
	tmp do: [ :ea | ea versionStringOn: strm. strm space; space ].
	strm cr.
	tmp do: 
		[ :ea | 
		(versions includes: ea branchNext)
			ifTrue: [self treeStringOn: strm startingAt: ea branchNext]].!

----- Method: VersionHistory>>treeStringStartingAt: (in category 'printing') -----
treeStringStartingAt: aVersion

	| strm |
	strm := WriteStream on: ''.
	self treeStringOn: strm startingAt: aVersion.
	^strm contents!

----- Method: VersionHistory>>versionBefore: (in category 'accessing') -----
versionBefore: aVersion

	"Answer the version immediately preceeding aVersion."

	| tmp |
	(aVersion > '1' asVersion) ifFalse: [^nil].
	(versions includes: (tmp := aVersion previous)) ifFalse: [^nil].
	^tmp!

----- Method: VersionHistory>>versionsAfter: (in category 'accessing') -----
versionsAfter: aVersion
	"Answer all the versions immediately following aVersion."

	| answer tmp |
	answer := Set new.
	tmp := aVersion next.
	(versions includes: aVersion next) ifTrue: [answer add: tmp].

	tmp := aVersion.
	[versions includes: (tmp := tmp branchNext)] whileTrue:
		[answer add: tmp].
	^answer!

----- Method: String>>asVersion (in category '*versionnumber') -----
asVersion
	"Answer a VersionNumber"

	^VersionNumber fromString: self!