--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/core/MetacelloProjectSpec.st Mon Sep 10 20:55:47 2012 +0000
@@ -0,0 +1,535 @@
+"{ Package: 'stx:goodies/metacello' }"
+
+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
+ | vrsn |
+
+ (vrsn := self versionOrNil) ifNotNil: [ ^ 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
+ | otherLoads |
+
+ self shouldBeMutable.
+ (otherLoads := aSpec loads)
+ ifNotNil: [ 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:: $'
+! !