core/MetacelloBaselineConstructor.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' }"

MetacelloAbstractVersionConstructor subclass:#MetacelloBaselineConstructor
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'Metacello-Core-Constructors'
!


!MetacelloBaselineConstructor class methodsFor:'instance creation'!

on: aConfig
    ^ self new
        on: aConfig;
        yourself
!

on: aConfig project: aProject
    ^ self new
        on: aConfig project: aProject;
        yourself
! !

!MetacelloBaselineConstructor methodsFor:'accessing'!

projectClass
    ^ MetacelloMCBaselineProject
! !

!MetacelloBaselineConstructor methodsFor:'initialization'!

on: aConfig
    self calculate: aConfig project: nil
!

on: aConfig project: aProject
    self calculate: aConfig project: aProject
! !

!MetacelloBaselineConstructor methodsFor:'pragma extraction'!

extractBaselinePragmaFor: aClass
    | pragmas |
    pragmas := Pragma allNamed: #'baseline' in: aClass.
    pragmas isEmpty
        ifTrue: [ ^ self error: 'No #baseline pragma found' ].
    ^ pragmas first
! !

!MetacelloBaselineConstructor methodsFor:'private'!

calculate: aConfig project: aProject
    | pragma versionMap versionSpec |
    self configuration: aConfig.
    pragma := self extractBaselinePragmaFor: aConfig class.
    self
        setProject:
            (aProject
                ifNil: [ 
                    [ aConfig class project ]
                        on: MessageNotUnderstood
                        do: [ :ex | ex return: nil ] ]).
    versionSpec := self project versionSpec.
    self root: versionSpec.
    self evaluatePragma: pragma.
    versionMap := Dictionary new.
    self project attributes
        do: [ :attribute | 
            | blockList |
            (blockList := self attributeMap at: attribute ifAbsent: [  ]) ~~ nil
                ifTrue: [ blockList do: [ :block | self with: versionSpec during: block ] ] ].
    versionSpec versionString: self project singletonVersionName.
    versionMap at: versionSpec versionString put: versionSpec createVersion.
    self project map: versionMap.
    self project configuration: aConfig
! !

!MetacelloBaselineConstructor class methodsFor:'documentation'!

version_SVN
    ^ '$Id::                                                                                                                        $'
! !