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

MetacelloSpec subclass:#MetacelloProjectSpec
	instanceVariableNames:'name className versionString operator loads preLoadDoIt
		postLoadDoIt'
	classVariableNames:''
	poolDictionaries:''
	category:'Metacello-Core-Specs'
!


!MetacelloProjectSpec methodsFor:'accessing'!

className: aString
    self shouldBeMutable.
    className := aString
!

file
    ^ nil
!

getClassName
    "raw access to iv"

    ^ className
!

getFile
    "raw access to iv"

    ^ nil
!

getOperator

	^operator
!

getRepositories
    "raw access to iv"

    ^ nil
!

loads: aCollection

	aCollection setLoadsInMetacelloProject: 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 ].
    self shouldBeMutable.
    name := aString
!

operator: anObject
    " #= #~= #> #< #>= #<= #~> "

    self shouldBeMutable.
    operator := anObject
!

postLoadDoIt: anObject

	anObject setPostLoadDoItInMetacelloSpec: self
!

preLoadDoIt: anObject

	anObject setPreLoadDoItInMetacelloSpec: self
!

setPostLoadDoIt: aSymbol
    self shouldBeMutable.
    postLoadDoIt := aSymbol
!

setPreLoadDoIt: aSymbol
    self shouldBeMutable.
    preLoadDoIt := aSymbol
!

versionString: anObject
    self shouldBeMutable.
    versionString := anObject
! !

!MetacelloProjectSpec methodsFor:'adding'!

addToMetacelloPackages: aMetacelloPackagesSpec

	| spec |
	spec := (aMetacelloPackagesSpec project projectReferenceSpec)
			name: self name;
			projectReference: self copy;
			yourself.
	aMetacelloPackagesSpec addMember: 
		(aMetacelloPackagesSpec addMember 
			name: spec name;
			spec: spec;
			yourself)
			
! !

!MetacelloProjectSpec methodsFor:'construction'!

className: aString constructor: aVersionConstructor
    aVersionConstructor classNameForProject: aString
!

loads: anObject constructor: aVersionConstructor
    aVersionConstructor loadsForProject: anObject
!

name: aString constructor: aVersionConstructor
    aVersionConstructor nameForProject: aString
!

operator: anObject constructor: aVersionConstructor
    aVersionConstructor operatorForProject: anObject
!

postLoadDoIt: aSymbol constructor: aVersionConstructor
    aVersionConstructor postLoadDoItForProject: aSymbol
!

preLoadDoIt: aSymbol constructor: aVersionConstructor
    aVersionConstructor preLoadDoItForProject: aSymbol
!

version: anObject constructor: aVersionConstructor
    aVersionConstructor versionForProject: anObject
!

versionString: anObject constructor: aVersionConstructor
    aVersionConstructor versionStringForProject: anObject
! !

!MetacelloProjectSpec methodsFor:'loading'!

load

	self subclassResponsibility
! !

!MetacelloProjectSpec methodsFor:'merging'!

mergeMap

	| map |
	map := super mergeMap.
	map at: #name put: name.
	map at: #className put: className.
	map at: #versionString put: versionString.
	map at: #operator put: operator.
	map at: #loads put: loads.
	map at: #preLoadDoIt put: preLoadDoIt.
	map at: #postLoadDoIt put: postLoadDoIt.
	^map
! !

!MetacelloProjectSpec methodsFor:'printing'!

configMethodBodyOn: aStream indent: indent
    | hasVersionString hasOperator hasProjectPackage hasLoads hasClassName hasPreLoadDoIt hasPostLoadDoIt |
    hasClassName := self hasClassName.
    hasVersionString := self versionString ~~ nil.
    hasOperator := operator ~~ nil.
    hasProjectPackage := self hasRepository or: [ hasClassName & (self getFile ~~ nil or: [ className ~= self name ]) ].
    hasLoads := self loads ~~ nil.
    hasPreLoadDoIt := self getPreLoadDoIt ~~ nil.
    hasPostLoadDoIt := self getPostLoadDoIt ~~ nil.
    hasClassName
        ifTrue: [ 
            hasVersionString | hasOperator | hasProjectPackage | hasLoads
                ifTrue: [ 
                    aStream
                        cr;
                        tab: indent + 1 ]
                ifFalse: [ aStream space ].
            aStream nextPutAll: 'className: ' , self className printString.
            hasVersionString | hasPreLoadDoIt | hasPostLoadDoIt | hasOperator | hasLoads | hasProjectPackage
                ifTrue: [ aStream nextPut: $; ] ].
    hasVersionString
        ifTrue: [ 
            | vs |
            hasClassName | hasOperator | hasProjectPackage | hasLoads | hasPreLoadDoIt | hasPostLoadDoIt
                ifTrue: [ 
                    aStream
                        cr;
                        tab: indent + 1 ]
                ifFalse: [ aStream space ].
            vs := self versionString.
            aStream nextPutAll: 'versionString: '.
            vs isSymbol
                ifTrue: [ aStream nextPut: $# ].
            aStream nextPutAll: vs asString printString.
            hasPreLoadDoIt | hasPostLoadDoIt | hasOperator | hasProjectPackage | hasLoads
                ifTrue: [ aStream nextPut: $; ] ].
    hasPreLoadDoIt
        ifTrue: [ 
            hasClassName | hasOperator | hasProjectPackage | hasLoads | hasPreLoadDoIt
                ifTrue: [ 
                    aStream
                        cr;
                        tab: indent + 1 ]
                ifFalse: [ aStream space ].
            aStream nextPutAll: 'preLoadDoIt: '.
            self preLoadDoIt value isSymbol
                ifTrue: [ 
                    aStream
                        nextPut: $#;
                        nextPutAll: self preLoadDoIt value asString printString ]
                ifFalse: [ aStream nextPutAll: self preLoadDoIt value asString ].
            hasPostLoadDoIt | hasOperator | hasProjectPackage | hasLoads
                ifTrue: [ aStream nextPut: $; ] ].
    hasPostLoadDoIt
        ifTrue: [ 
            hasClassName | hasOperator | hasProjectPackage | hasLoads | hasPostLoadDoIt
                ifTrue: [ 
                    aStream
                        cr;
                        tab: indent + 1 ]
                ifFalse: [ aStream space ].
            aStream nextPutAll: 'postLoadDoIt: '.
            self postLoadDoIt value isSymbol
                ifTrue: [ 
                    aStream
                        nextPut: $#;
                        nextPutAll: self postLoadDoIt value asString printString ]
                ifFalse: [ aStream nextPutAll: self postLoadDoIt value asString ].
            hasOperator | hasProjectPackage | hasLoads
                ifTrue: [ aStream nextPut: $; ] ].
    hasOperator
        ifTrue: [ 
            hasClassName | hasVersionString | hasProjectPackage | hasLoads | hasPreLoadDoIt | hasPostLoadDoIt
                ifTrue: [ 
                    aStream
                        cr;
                        tab: indent + 1 ]
                ifFalse: [ aStream space ].
            aStream nextPutAll: 'operator: #' , self operator asString printString.
            hasProjectPackage | hasLoads
                ifTrue: [ aStream nextPut: $; ] ].
    hasLoads
        ifTrue: [ 
            hasClassName | hasVersionString | hasOperator | hasProjectPackage | hasPreLoadDoIt | hasPostLoadDoIt
                ifTrue: [ 
                    aStream
                        cr;
                        tab: indent + 1 ]
                ifFalse: [ aStream space ].
            aStream nextPutAll: 'loads: #('.
            self loads do: [ :str | aStream nextPutAll: str printString , ' ' ].
            aStream nextPut: $).
            hasProjectPackage
                ifTrue: [ aStream nextPut: $; ] ].
    hasProjectPackage
        ifTrue: [ 
            | hasName hasRepo |
            hasRepo := self hasRepository.
            hasName := self file ~= self className.
            hasName
                ifTrue: [ 
                    hasClassName | hasVersionString | hasOperator | hasLoads | hasPreLoadDoIt | hasPostLoadDoIt
                        ifTrue: [ 
                            aStream
                                cr;
                                tab: indent + 1 ]
                        ifFalse: [ aStream space ].
                    aStream nextPutAll: 'file: ' , self file printString.
                    hasRepo
                        ifTrue: [ aStream nextPut: $; ] ].
            hasRepo
                ifTrue: [ 
                    | repos |
                    repos := self repositories map values.
                    repos size = 1
                        ifTrue: [ 
                            hasClassName | hasVersionString | hasOperator | hasLoads | hasPreLoadDoIt | hasPostLoadDoIt | hasName
                                ifTrue: [ 
                                    aStream
                                        cr;
                                        tab: indent + 1 ]
                                ifFalse: [ aStream space ].
                            repos first configMethodCascadeOn: aStream lastCascade: true ]
                        ifFalse: [ 
                            aStream cr.
                            self repositories configMethodCascadeOn: aStream indent: indent ] ] ]
!

configMethodOn: aStream indent: indent

	aStream 
		tab: indent;
		nextPutAll: 'spec '; cr;
		tab: indent + 1;
		nextPutAll: 'name: ', self name printString, ';'.
	self configMethodBodyOn: aStream indent: indent.
	aStream nextPut: $.
!

configShortCutMethodOn: aStream member: aMember indent: indent
    | hasVersionString hasOperator hasProjectPackage hasLoads hasClassName hasPreLoadDoIt hasPostLoadDoIt |
    hasClassName := self hasClassName.
    hasVersionString := self versionString ~~ nil.
    hasOperator := operator ~~ nil.
    hasProjectPackage := self hasRepository or: [ hasClassName & (self getFile ~~ nil or: [ className ~= self name ]) ].
    hasLoads := self loads ~~ nil.
    hasPreLoadDoIt := self getPreLoadDoIt ~~ nil.
    hasPostLoadDoIt := self getPostLoadDoIt ~~ nil.
    hasClassName | hasOperator | hasProjectPackage | hasLoads | hasPreLoadDoIt | hasPostLoadDoIt
        ifTrue: [ 
            (aMember methodUpdateSelector == #'copy:' or: [ aMember methodUpdateSelector == #'with:' ])
                ifTrue: [ 
                    aStream
                        nextPutAll: 'with: [';
                        cr ]
                ifFalse: [ 
                    aStream
                        nextPutAll: 'overrides: [';
                        cr ].
            aStream
                tab: indent;
                nextPutAll: 'spec'.
            self configMethodBodyOn: aStream indent: indent.
            aStream nextPutAll: ' ]'.
            ^ self ].
    hasVersionString
        ifTrue: [ 
            | vs |
            vs := self versionString.
            aStream nextPutAll: 'with: '.
            vs isSymbol
                ifTrue: [ aStream nextPut: $# ].
            aStream nextPutAll: vs asString printString ]
!

hasClassName
    ^ className ~~ nil
!

label

	^self name
!

projectLabel
    ^ 'project'
! !

!MetacelloProjectSpec methodsFor:'private'!

constructClassName
    ^ nil
!

loadListForVersion: vrsn 

	^ (self loads == nil
			or: [self loads isEmpty])
		ifTrue: [vrsn spec defaultPackageNames]
		ifFalse: [self loads]
!

setLoads: aCollection
    self shouldBeMutable.
    loads := aCollection
!

setName: aStringOrNil
    self shouldBeMutable.
    name := aStringOrNil
! !

!MetacelloProjectSpec methodsFor:'querying'!

className
    className ifNil: [ self name ifNotNil: [ self className: self constructClassName ] ].
    ^ className
!

currentlyLoadedClassesInVersion
    self versionOrNil ifNotNil: [ :vrsn | ^ vrsn currentlyLoadedClassesInVersion ].
    ^ #()
!

getPostLoadDoIt

	^postLoadDoIt
!

getPreLoadDoIt

	^preLoadDoIt
!

loads
	^ loads
!

name

	^name
!

operator

	operator == nil ifTrue: [ ^#>= ].
	^ operator
!

postLoadDoIt

	^postLoadDoIt
!

preLoadDoIt

	^preLoadDoIt
!

projectPackage

	^nil
!

version
    self subclassResponsibility
!

versionKey
	"suitable for using as a unique key for the receiver's version in a dictionary"

	^ self version versionKey
!

versionOrNil

	^[ self version ] on: MetacelloVersionDoesNotExistError do: [:ex | ^nil ].
!

versionString
	^ versionString
! !

!MetacelloProjectSpec methodsFor:'scripting'!

asProjectRegistration
    ^ MetacelloProjectRegistration fromProjectSpec: self
!

canDowngradeTo: aMetacelloProjectSpec
    (self className = aMetacelloProjectSpec className and: [ self operator == aMetacelloProjectSpec operator ])
        ifFalse: [ ^ false ].
    ^ (aMetacelloProjectSpec version perform: self operator with: self version) not
!

canUpgradeTo: aMetacelloProjectSpec
    (self className = aMetacelloProjectSpec className and: [ self operator == aMetacelloProjectSpec operator ])
        ifFalse: [ ^ false ].
    ^ aMetacelloProjectSpec version perform: self operator with: self version
!

compareEqual: aMetacelloProjectSpec
    "name className versionString operator loads preLoadDoIt postLoadDoIt"

    ^ self className = aMetacelloProjectSpec className
        and: [ 
            self versionString = aMetacelloProjectSpec versionString
                and: [ 
                    self operator == aMetacelloProjectSpec operator
                        and: [ 
                            self loads = aMetacelloProjectSpec loads
                                and: [ self preLoadDoIt == aMetacelloProjectSpec preLoadDoIt and: [ self postLoadDoIt == aMetacelloProjectSpec postLoadDoIt ] ] ] ] ]
!

mergeScriptLoads: aSpec
    self shouldBeMutable.
    aSpec loads
        ifNotNil: [ :otherLoads | self loads ifNil: [ loads := otherLoads ] ifNotNil: [ loads := (loads , otherLoads) asSet asArray ] ].
    self loader: aSpec loader
!

metacelloRegistrationHash
    "name className versionString operator loads preLoadDoIt postLoadDoIt"

    | hash |
    hash := String stringHash: name initialHash: 0.
    hash := String stringHash: self className initialHash: hash.
    hash := String stringHash: self versionString initialHash: hash.
    hash := String stringHash: self operator asString initialHash: hash.
    hash := String stringHash: self preLoadDoIt asString initialHash: hash.
    hash := String stringHash: self postLoadDoIt asString initialHash: hash.
    ^ hash bitXor: loads hash
!

registration
    ^ MetacelloProjectRegistration
        registrationForProjectSpec: self
        ifAbsent: [ :ignored |  ]
        ifPresent: [ :existing :new | existing ]
!

registrationsCompareEqual: aMetacelloProjectSpec
    "name className versionString operator loads preLoadDoIt postLoadDoIt"

    ^ self className = aMetacelloProjectSpec className
        and: [ self versionString = aMetacelloProjectSpec versionString and: [ self operator == aMetacelloProjectSpec operator ] ]
!

unregisterProject
    ^ MetacelloProjectRegistration
        registrationForProjectSpec: self
        ifAbsent: [  ]
        ifPresent: [ :existing :new | existing unregisterProject ]
! !

!MetacelloProjectSpec methodsFor:'visiting'!

projectDo: projectBlock packageDo: packageBlock groupDo: groupBlock
    projectBlock value: self
! !

!MetacelloProjectSpec class methodsFor:'documentation'!

version_SVN
    ^ '$Id::                                                                                                                        $'
! !