"{ Package: 'stx:goodies/metacello' }"

MetacelloMemberListSpec subclass:#MetacelloPackagesSpec
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'Metacello-Core-Specs'
!


!MetacelloPackagesSpec methodsFor:'accessing'!

applyIncludesTo: orderedSpecs for: pkgSpec firstTime: firstTime
	| movedSpecs baseIndex includedSpec result |
	movedSpecs := Set new.
	baseIndex := orderedSpecs indexOf: pkgSpec.
	pkgSpec includesForPackageOrdering
		do: [:includedSpecName | 
			includedSpec := orderedSpecs
						detect: [:spec | spec name = includedSpecName ]
						ifNone: [].
			(self slideIn: orderedSpecs spec: includedSpec baseIndex: baseIndex seen: IdentitySet new firstTime: firstTime)
				ifTrue: [ movedSpecs add: includedSpec name ]].
	^ movedSpecs
!

packageNamed: aString ifAbsent: aBlock

	^self map at: aString ifAbsent: aBlock
!

packageSpecsInLoadOrder

	| orderedSpecs moved lastMovedSpecs count terminationLimit map specsWithIncludes firstTime |
	"specification order is the default order"
	map := self map.
	orderedSpecs := OrderedCollection new.
	self list do: [:member | | spec |
		spec := map at: member name ifAbsent: [].
		(spec == nil or: [ orderedSpecs includes: spec ])
			ifFalse: [ orderedSpecs add: spec ]].
	orderedSpecs isEmpty ifTrue: [ ^orderedSpecs ].
	moved := true.
	count := 0.
	terminationLimit := orderedSpecs size * 2.
	[ moved  ] whileTrue: [
		count := count + 1.
		count > terminationLimit 
			ifTrue: [
				"Cheap termination hack - an APPARENT loop"
				self error: 'Apparent loop in before/after dependency definitions' ]. 
		moved := false.
		orderedSpecs do: [:packageSpec | 
			moved := moved or: [ self sortPackageSpecs: orderedSpecs for: packageSpec ]]].
	lastMovedSpecs := Set new.
	moved := true.
	count := 0.
	specsWithIncludes := orderedSpecs select: [:pkgSpec | pkgSpec includesForPackageOrdering isEmpty not].
	firstTime := true.
	[ moved ] whileTrue: [ | result |
		count := count + 1.
		"count > terminationLimit"
		count > 7
			ifTrue: [
				"Cheap termination hack - an APPARENT loop"
				self error: 'Apparent loop in before/after dependency definitions' ]. 
		moved := false.
		result := Set new.
		specsWithIncludes do: [:packageSpec |
			result addAll: (self applyIncludesTo: orderedSpecs for: packageSpec firstTime: firstTime) ].
		result size = lastMovedSpecs size
			ifTrue: [
				result do: [:name | (lastMovedSpecs includes: name) ifFalse: [ moved := true ]]]
			ifFalse: [ moved := true ].
		lastMovedSpecs := result.
		firstTime := false ].
	^orderedSpecs
!

slideIn: orderedSpecs spec: targetSpec baseIndex: baseIndex seen: seen firstTime: firstTime
	| targetIndex requires targetRequires targetRequiresIndexes minIndex baseSpec required |

	(seen includes: targetSpec) ifTrue: [ ^false ].
	targetIndex := orderedSpecs indexOf: targetSpec.
	baseIndex >= targetIndex ifTrue: [ ^false ].
	required := false.
	baseSpec := orderedSpecs at: baseIndex.
	baseIndex + 1 to: targetIndex - 1 do: [:index | | spec |
		spec := orderedSpecs at: index.
		(spec requires includes: baseSpec name) ifTrue: [ required := true ]].
	firstTime ifFalse: [ required ifFalse: [ ^false ]].
	requires := targetSpec requires.
	targetRequires := orderedSpecs
				select: [:spec | requires includes: spec name].
	targetRequiresIndexes := targetRequires
				collect: [:spec | orderedSpecs indexOf: spec].
	targetRequiresIndexes add: baseIndex.
	minIndex := targetRequiresIndexes
				detectMax: [:each | each].
	minIndex + 1 < targetIndex
		ifTrue: [
			orderedSpecs remove: targetSpec.
			orderedSpecs add: targetSpec afterIndex: minIndex.
			seen add: targetSpec ]
		ifFalse: [ ^self slideIn: orderedSpecs spec: (orderedSpecs at: minIndex) baseIndex: 1 seen: seen firstTime: firstTime].
	^true
! !

!MetacelloPackagesSpec methodsFor:'actions'!

add: aSpec

	aSpec addToMetacelloPackages: self
!

copy: specNamed to: spec

	self addMember: 
		(self copyMember 
			name: spec name;
			sourceName: specNamed;
			spec: spec;
			yourself)
!

merge: aSpec

	aSpec mergeIntoMetacelloPackages: self
!

remove: aSpec

	aSpec removeFromMetacelloPackages: self
! !

!MetacelloPackagesSpec methodsFor:'printing'!

configMethodOn: aStream indent: indent

	| packageSpecs |
	packageSpecs := self map values.
	packageSpecs size = 0 ifTrue: [ ^aStream nextPutAll: 'spec add: []' ].
	packageSpecs size = 1
		ifTrue: [
			aStream 
				tab: indent; 
				nextPutAll: 'spec add: ['; cr.
			packageSpecs first configMethodOn: aStream indent: indent + 1.
			aStream nextPut: $]; cr ]
		ifFalse: [
			aStream 
				tab: indent; 
				nextPutAll: 'spec'.
			1 to: packageSpecs size do: [:index | | packageSpec |
				packageSpec := packageSpecs at: index.
				aStream 
					tab: indent + 1;
					nextPutAll: 'add: ['; cr.
				packageSpec configMethodOn: aStream indent: indent + 2.
				aStream nextPut: $].
				index < packageSpecs size
					ifTrue: [ aStream nextPut: $; ].
				aStream cr ]]
! !

!MetacelloPackagesSpec methodsFor:'private'!

sortPackageSpecs: orderedSpecs for: packageSpec

	| packageIndex moved movePackage targetPackage targetIndex targetPackages |
	packageIndex := orderedSpecs indexOf: packageSpec.
	moved := movePackage := false.
	targetPackages := packageSpec requires.
	targetPackages do: [:targetPackageName |
		targetPackage := orderedSpecs 
			detect: [:each | each name = targetPackageName ] 
			ifNone: [].
		targetIndex := orderedSpecs indexOf: targetPackage.
		movePackage := movePackage or: [ packageIndex <= targetIndex ]].
	movePackage 
		ifTrue: [
			moved := true.
			orderedSpecs remove: packageSpec ifAbsent: [ ^self error: 'unexpected error removing package' ].
			targetIndex := 0.
			targetPackages do: [:targetPackageName | 
				(targetPackage := orderedSpecs detect: [:each | 
					each name = targetPackageName ] ifNone: []) ~~ nil
						ifTrue: [ targetIndex := targetIndex max: (orderedSpecs indexOf: targetPackage) ]].
			targetIndex == 0
				ifTrue: [ orderedSpecs add: packageSpec beforeIndex: packageIndex ]
				ifFalse: [ orderedSpecs add: packageSpec afterIndex: targetIndex ]].
	^moved
! !

!MetacelloPackagesSpec class methodsFor:'documentation'!

version_SVN
    ^ '$Id::                                                                                                                        $'
! !