core/MetacelloAbstractPackageSpec.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Wed, 19 Sep 2012 01:38:26 +0000
changeset 20 8caf2f257260
parent 16 25ac697dc747
permissions -rw-r--r--
- fixes for package support

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

MetacelloSpec subclass:#MetacelloAbstractPackageSpec
	instanceVariableNames:'name requires includes answers'
	classVariableNames:''
	poolDictionaries:''
	category:'Metacello-Core-Specs'
!


!MetacelloAbstractPackageSpec methodsFor:'accessing'!

answers: aListOfPairs

	self setAnswers: aListOfPairs
!

includes: aCollection

	aCollection setIncludesInMetacelloPackage: self
!

name: aString
    ((aString at: 1) isSeparator or: [ (aString at: aString size) isSeparator ])
        ifTrue: [ self error: 'Names are not allowed to have leading or trailing blanks: ' , aString printString ].
    name := aString
!

referencedSpec

	^self
!

requires: aCollection

	aCollection setRequiresInMetacelloPackage: self
! !

!MetacelloAbstractPackageSpec methodsFor:'adding'!

addToMetacelloPackages: aMetacelloPackagesSpec

	aMetacelloPackagesSpec addMember: 
		(aMetacelloPackagesSpec addMember 
			name: self name;
			spec: self;
			yourself)
! !

!MetacelloAbstractPackageSpec methodsFor:'copying'!

postCopy

	super postCopy.
	requires := requires copy.
	includes := includes copy.
	answers := answers copy.
! !

!MetacelloAbstractPackageSpec methodsFor:'merging'!

mergeIntoMetacelloPackages: aMetacelloPackagesSpec

	aMetacelloPackagesSpec addMember: 
		(aMetacelloPackagesSpec mergeMember 
			name: self name;
			spec: self;
			yourself)
!

mergeMap

	| map |
	map := super mergeMap.
	map at: #requires put: requires.
	map at: #includes put: includes.
	map at: #answers put: answers.
	^map
!

mergeSpec: anotherSpec

	| newSpec map anotherRequires anotherIncludes anotherAnswers |
	newSpec := super mergeSpec: anotherSpec.
	map := anotherSpec mergeMap.
	anotherSpec name ~~ nil 
		ifTrue: [ newSpec name: anotherSpec name ].
	(anotherRequires := map at: #requires) ~~ nil
		ifTrue: [ newSpec setRequires: self requires, anotherRequires ].
	(anotherIncludes := map at: #includes) ~~ nil
		ifTrue: [ newSpec setIncludes: self includes, anotherIncludes ].
	(anotherAnswers := map at: #answers) ~~ nil
		ifTrue: [ newSpec setAnswers: self answers, anotherAnswers ].
	^newSpec
	
!

nonOverridable

	^#( includes requires answers )
! !

!MetacelloAbstractPackageSpec methodsFor:'printing'!

configMethodBodyOn: aStream hasName: hasName cascading: cascading indent: indent

	| hasCascading hasRequires hasIncludes hasAnswers |
	hasCascading := cascading.
	hasRequires := self requires isEmpty not.
	hasIncludes := self includes isEmpty not.
	hasAnswers := self answers isEmpty not.
	hasRequires
		ifTrue: [ 
			hasName | hasIncludes | hasAnswers | hasCascading
				ifTrue: [ aStream cr; tab: indent ].
			aStream nextPutAll: 'requires: #('.
			self requires do: [:str | aStream nextPutAll: str printString, ' ' ].
			hasIncludes | hasAnswers | hasCascading
				ifTrue: [ aStream nextPutAll: ');' ]
				ifFalse: [ aStream nextPut: $) ]].
	hasIncludes
		ifTrue: [ 
			hasName | hasRequires | hasAnswers | hasCascading
				ifTrue: [ aStream cr; tab: indent ].
			aStream nextPutAll: 'includes: #('.
			self includes do: [:str | aStream nextPutAll: str printString, ' ' ].
			hasAnswers | hasCascading
				ifTrue: [ aStream nextPutAll: ');' ]
				ifFalse: [ aStream nextPut: $) ]].
	hasAnswers
		ifTrue: [ 
			hasName | hasRequires | hasIncludes | hasCascading
				ifTrue: [ aStream cr; tab: indent ].
			aStream nextPutAll: 'supplyingAnswers: #( '.
			self answers do: [:ar | 
				aStream nextPutAll: '#( '.
				ar do: [:val | 
					(val isString or: [ val isNumber or: [ val isSymbol or: [ val isCharacter ]]])
						ifTrue: [  aStream nextPutAll: val printString, ' ' ].
					val == true
						ifTrue: [  aStream nextPutAll: 'true ' ].
					val == false
						ifTrue: [  aStream nextPutAll: 'false ' ]].
				aStream nextPutAll: ') ' ].
			hasCascading
				ifTrue: [ aStream nextPutAll: ');' ]
				ifFalse: [ aStream nextPut: $) ]].
!

configMethodCascadeOn: aStream member: aMember last: lastCascade indent: indent

	self subclassResponsibility
!

configMethodOn: aStream for: aValue selector: selector cascading: cascading cascade: cascade indent: indent

	| valuePrintString |
	aValue == nil ifTrue: [ ^self ].
	cascading ifTrue: [ aStream cr; tab: indent ].
	valuePrintString := aValue value isSymbol
		ifTrue: [ '#' , aValue value asString printString ]
		ifFalse: [ aValue value printString ].
	aStream  nextPutAll: selector, valuePrintString.
	cascade ifTrue: [ aStream nextPut: $; ]
!

label

	^self name
! !

!MetacelloAbstractPackageSpec methodsFor:'private'!

includesForPackageOrdering

	^#()
!

setAnswers: aCollection

	answers := aCollection
!

setIncludes: aCollection

	includes := aCollection
!

setRequires: aCollection

	requires := aCollection
! !

!MetacelloAbstractPackageSpec methodsFor:'querying'!

answers

	answers == nil ifTrue: [ answers := #() ].
	^answers
!

includes

	includes == nil ifTrue: [ includes := #() ].
	^includes
!

name

	^name
!

requires

	requires == nil ifTrue: [ requires := #() ].
	^requires
! !

!MetacelloAbstractPackageSpec methodsFor:'removing'!

removeFromMetacelloPackages: aMetacelloPackagesSpec

	aMetacelloPackagesSpec addMember: 
		(aMetacelloPackagesSpec removeMember 
			name: self name;
			spec: self;
			yourself)
! !

!MetacelloAbstractPackageSpec methodsFor:'testing'!

hasRepository
    ^ false
! !

!MetacelloAbstractPackageSpec methodsFor:'visiting'!

projectDo: projectBlock packageDo: packageBlock groupDo: groupBlock

	self subclassResponsibility
! !

!MetacelloAbstractPackageSpec class methodsFor:'documentation'!

version_SVN
    ^ '$Id::                                                                                                                        $'
! !