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

Object subclass:#MetacelloPlatform
	instanceVariableNames:'bypassProgressBars bypassGoferLoadUpdateCategories'
	classVariableNames:'Current'
	poolDictionaries:''
	category:'Metacello-Core-Model'
!


!MetacelloPlatform class methodsFor:'accessing'!

current
	Current
		ifNil: [Current := MetacelloPlatform new].
	^ Current
! !

!MetacelloPlatform class methodsFor:'initialize-release'!

initialize
	"MetacelloPlatform initialize"
	"MetacelloGemStonePlatform initialize"
	"MetacelloPharoPlatform initialize"
	"MetacelloSqueakPlatform initialize"

	Current := self new
! !

!MetacelloPlatform methodsFor:'accessing'!

bypassGoferLoadUpdateCategories

	bypassGoferLoadUpdateCategories == nil ifTrue: [ bypassGoferLoadUpdateCategories := false ].
	^ bypassGoferLoadUpdateCategories
!

bypassGoferLoadUpdateCategories: anObject
	bypassGoferLoadUpdateCategories := anObject
!

bypassProgressBars

	bypassProgressBars == nil ifTrue: [ bypassProgressBars := false ].
	^ bypassProgressBars
!

bypassProgressBars: anObject
	bypassProgressBars := anObject
! !

!MetacelloPlatform methodsFor:'attributes'!

defaultPlatformAttributes
	| versionString |
	Smalltalk at: #SystemVersion ifPresent: [:cl |
		versionString := cl current version.
		(versionString beginsWith: 'Pharo')
			ifTrue: [ ^ #(#squeakCommon #pharo ) ].
		(versionString beginsWith: 'Squeak')
			ifTrue: [^ #(#squeakCommon #squeak )].
		"see http://code.google.com/p/metacello/issues/detail?id=146"
		(versionString includesSubString: 'Pharo')
			ifTrue: [ ^ #(#squeakCommon #pharo ) ].
		(versionString includesSubString: 'Squeak')
			ifTrue: [^ #(#squeakCommon #squeak )].
		self error: 'Unrecognized version of Squeak/Pharo: ', versionString ].
	^ #(#gemstone )
! !

!MetacelloPlatform methodsFor:'caching'!

clearCurrentVersionCache
	MetacelloClearStackCacheNotification signal: #(#currentVersion #currentVersionAgainst: #currentVersionInfo)
!

primeStackCacheFor: cacheName doing: noArgBlock defaultDictionary: aDictionary

	self deprecated: 'use #primeStackCacheWith:doing:'.
	self 
		useStackCacheDuring: [:dict | | cache |
			cache := dict at: cacheName ifAbsent: [].
			cache == nil
				ifTrue: [ 
					cache := Dictionary new.
					dict at: cacheName put: cache ].
			^noArgBlock value ] 
		defaultDictionary: aDictionary
!

primeStackCacheWith: aDictionary doing: noArgBlock

	self 
		useStackCacheDuring: [:dict | ^noArgBlock value ] 
		defaultDictionary: aDictionary
!

stackCacheFor: cacheName at: key doing: aBlock

	^self stackCacheFor: cacheName cacheClass: Dictionary at: key doing: aBlock
!

stackCacheFor: cacheName cacheClass: cacheClass at: key doing: aBlock

	self 
		useStackCacheDuring: [:dict | | cache |
			cache := dict at: cacheName ifAbsent: [].
			cache ~~ nil
				ifTrue: [ | value hasEntry |
					hasEntry := true.
					value := cache at: key ifAbsent: [ hasEntry := false ].
					hasEntry ifTrue: [ ^value ]]
				ifFalse: [ 
					cache := cacheClass new.
					dict at: cacheName put: cache ].
			^aBlock value: cache ] 
		defaultDictionary: nil
!

useStackCacheDuring: aBlock defaultDictionary: defaultDictionary
        | dict |
        dict := MetacelloStackCacheNotification raiseSignal.
        dict == nil
                ifTrue: [ 
                        dict := defaultDictionary == nil
                                ifTrue: [ Dictionary new ]
                                ifFalse: [ defaultDictionary ] ].
        [ ^ aBlock value: dict ]
                on: MetacelloStackCacheNotification , MetacelloClearStackCacheNotification
                do: [ :ex | 
                        (ex isKindOf: MetacelloStackCacheNotification)
                                ifTrue: [ ex resume: dict ].
                        (ex isKindOf: MetacelloClearStackCacheNotification)
                                ifTrue: [ 
                                        | keys |
                                        keys := ex cacheNames.
                                        keys ifNil: [ keys := dict keys ].
                                        keys
                                                do: [ :k | 
                                                        (dict includesKey: k)
                                                                ifTrue: [ 
                                                                        | c |
                                                                        c := dict at: k.
                                                                        c keys do: [ :ck | c removeKey: ck ].
                                                                        dict removeKey: k ] ].
                                        ex resume ] ]

    "Modified: / 02-10-2012 / 23:33:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MetacelloPlatform methodsFor:'github support'!

downloadFile: url to: outputFileName
    "download from <url> into <outputFileName>"

    self subclassResponsibility
!

extractRepositoryFrom: zipFile to: directory
    "unzip <zipFile> into <directory>"

    self subclassResponsibility
!

fileDirectoryClass

	^FileDirectory
! !

!MetacelloPlatform methodsFor:'notification'!

collection: aCollection do: aBlock displaying: aString

	aCollection do: aBlock
!

do: aBlock displaying: aString

	aBlock value
! !

!MetacelloPlatform methodsFor:'reflection'!

copyClass: oldClass as: newName inCategory: newCategoryName

	self subclassResponsibility
!

globalNamed: globalName

	^Smalltalk at: globalName
!

globalNamed: globalName ifAbsent: absentBlock

	^Smalltalk at: globalName ifAbsent: absentBlock
! !

!MetacelloPlatform methodsFor:'repository creation'!

createRepository: aRepositorySpec
    | type |
    type := aRepositorySpec type.
    type = 'http'
        ifTrue: [ 
            ^ MCHttpRepository
                location: aRepositorySpec description
                user: aRepositorySpec username
                password: aRepositorySpec password ].
    type = 'directory'
        ifTrue: [ ^ MCDirectoryRepository new directory: (FileDirectory on: aRepositorySpec description) ].
    Smalltalk
        at: #'MCFileTreeRepository'
        ifPresent: [ :cl | 
            type = 'filetree'
                ifTrue: [ 
                    | description headerSize |
                    description := aRepositorySpec description.
                    headerSize := 'filetree://' size.
                    ^ cl new
                        directory:
                            (FileDirectory on: (aRepositorySpec description copyFrom: headerSize + 1 to: description size)) ] ].
    Smalltalk
        at: #'MCGitHubRepository'
        ifPresent: [ :cl | 
            type = 'github'
                ifTrue: [ ^ cl location: aRepositorySpec description ] ].
    type = 'dictionary'
        ifTrue: [ 
            | description headerSize globalName |
            description := aRepositorySpec description.
            headerSize := 'dictionary://' size.
            globalName := (description copyFrom: headerSize + 1 to: description size) asSymbol.
            ^ Smalltalk
                at: globalName
                ifAbsent: [ 
                    Smalltalk
                        at: globalName
                        put:
                            (MCDictionaryRepository new
                                description: description;
                                yourself) ] ].
    ^ nil
!

extractTypeFromDescription: description
    description == nil
        ifTrue: [ ^ nil ].
    ((description beginsWith: '/') or: [ description second = $: ])
        ifTrue: [ ^ 'directory' ].
    (description beginsWith: 'dictionary://')
        ifTrue: [ ^ 'dictionary' ].
    (description beginsWith: 'filetree://')
        ifTrue: [ ^ 'filetree' ].
    (description beginsWith: 'github://')
        ifTrue: [ ^ 'github' ].
    ^ 'http'
! !

!MetacelloPlatform methodsFor:'scripting'!

defaultRepositoryDescription
    ^ 'http://www.squeaksource.com/MetacelloRepository'
! !

!MetacelloPlatform methodsFor:'tests'!

defaultTimeout
	"squeak compatability"
	^60
! !

!MetacelloPlatform methodsFor:'transactions'!

transact: aBlock
	"On GemStone, we want to optionally abort before command execution and commit after 
	 common execution. Other plaforms don't need to do anything special.
	 Returning out of block, skips commit."
	
	aBlock value
! !

!MetacelloPlatform methodsFor:'user interaction'!

confirm: aString
	
	^(Smalltalk hasClassNamed: #UIManager)
		ifTrue: [ (Smalltalk classNamed: #UIManager) default perform: #confirm: with: aString ]
		ifFalse: [
			"throw warning and answer true, if no way to announce"
			Warning signal: aString.
			true ]
! !

!MetacelloPlatform methodsFor:'utilities'!

authorName

	Smalltalk at: #Author ifPresent: [:cl | ^cl perform: #initials ].
	^'no developer initials'
!

authorName: aString
	"Primarily used for testing"

	self subclassResponsibility
!

timestamp

	^DateAndTime now printString
! !

!MetacelloPlatform class methodsFor:'documentation'!

version_SVN
    ^ '$Id::                                                                                                                        $'
! !

MetacelloPlatform initialize!