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

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 signal.

	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 ] ]

! !

!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!