[etoys-notify] Etoys: MonticelloConfigurations-ar.75.mcz

[commits at source.squeak.org]

Bert Freudenberg uploaded a new version of MonticelloConfigurations to project Etoys:
http://source.squeak.org/etoys/MonticelloConfigurations-ar.75.mcz

==================== Summary ====================

Name: MonticelloConfigurations-ar.75
Author: ar
Time: 9 April 2010, 8:43:20.141 pm
UUID: 31c70736-0388-9448-a7fd-c27a4796f6d9
Ancestors: MonticelloConfigurations-mpe.74

Release preps: Make the default update URL a preference so that we can change it easily.

==================== Snapshot ====================

SystemOrganization addCategory: #MonticelloConfigurations!

MCTool subclass: #MCConfigurationBrowser
	instanceVariableNames: 'configuration dependencyIndex repositoryIndex'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MonticelloConfigurations'!

----- Method: MCConfigurationBrowser class>>initialize (in category 'class initialization') -----
initialize
	TheWorldMenu registerOpenCommand: { 'Monticello Configurations' . { self . #open }. 'Monticello Configuration Browser' }.!

----- Method: MCConfigurationBrowser class>>open (in category 'opening') -----
open
	^self new show!

----- Method: MCConfigurationBrowser>>add (in category 'actions') -----
add
	(self pickWorkingCopiesSatisfying: [:each | (self includesPackage: each package) not])
		do: [:wc |
			wc ancestors isEmpty
				ifTrue: [self inform: 'You must save ', wc packageName, ' first!!
Skipping this package']
				ifFalse: [
					self dependencies add: (MCVersionDependency
						package: wc package
						info: wc ancestors first)]].
	self changed: #dependencyList; changed: #description!

----- Method: MCConfigurationBrowser>>addDependency (in category 'dependencies') -----
addDependency
	(self pickWorkingCopiesSatisfying: [:each | (self includesPackage: each package) not])
		do: [:wc |
			wc ancestors isEmpty
				ifTrue: [self inform: 'You must save ', wc packageName, ' first!!
Skipping this package']
				ifFalse: [
					self dependencies add: (MCVersionDependency
						package: wc package
						info: wc ancestors first)]].
	self changed: #dependencyList; changed: #description!

----- Method: MCConfigurationBrowser>>addRepository (in category 'repositories') -----
addRepository
	(self pickRepositorySatisfying: [:ea | (self repositories includes: ea) not])
		ifNotNil: [:repo |
			(repo isKindOf: MCHttpRepository)
				ifFalse: [^self inform: 'Only HTTP repositories are supported'].
			self repositories add: repo.
			self changed: #repositoryList.
		]!

----- Method: MCConfigurationBrowser>>buttonSpecs (in category 'morphic ui') -----
buttonSpecs
	^ #(('Add' add 'Add a dependency')
		('Update' updateMenu 'Update dependencies')
		('Install' installMenu 'Load/Merge/Upgrade into image')
		('Up' up 'Move item up in list' canMoveUp)
		('Down' down 'Move item down in list' canMoveDown)
		('Remove' remove 'Remove item' canRemove)
		('Store' store 'store configuration')
		('Post' post 'Post this configuration to an update stream')
		)!

----- Method: MCConfigurationBrowser>>canMoveDown (in category 'testing') -----
canMoveDown
	^self index between: 1 and: self maxIndex - 1 !

----- Method: MCConfigurationBrowser>>canMoveUp (in category 'testing') -----
canMoveUp
	^self index > 1!

----- Method: MCConfigurationBrowser>>canRemove (in category 'testing') -----
canRemove
	^self index > 0!

----- Method: MCConfigurationBrowser>>changedButtons (in category 'selection') -----
changedButtons
	self changed: #canMoveDown.
	self changed: #canMoveUp.
	self changed: #canRemove.!

----- Method: MCConfigurationBrowser>>changedList (in category 'selection') -----
changedList
	self dependencyIndex > 0 ifTrue: [^self changed: #dependencyList].
	self repositoryIndex > 0 ifTrue: [^self changed: #repositoryList].
	self error: 'nothing selected'!

----- Method: MCConfigurationBrowser>>checkDependencies (in category 'dependencies') -----
checkDependencies
	^self checkModified and: [self checkMissing]!

----- Method: MCConfigurationBrowser>>checkMissing (in category 'dependencies') -----
checkMissing
	| missing |
	missing := (self dependencies collect: [:ea | ea versionInfo name]) asSet.

	self repositories
		do: [:repo |
			repo allVersionNames
				do: [:found | missing remove: found ifAbsent: []]]
		displayingProgress: 'searching versions'.

	^missing isEmpty or: [
		self selectDependency: missing anyOne.
		self confirm: (String streamContents: [:strm |
			strm nextPutAll: 'No repository found for'; cr.
			missing do: [:r | strm nextPutAll: r; cr].
			strm nextPutAll: 'Do you still want to store?'])]
	!

----- Method: MCConfigurationBrowser>>checkModified (in category 'dependencies') -----
checkModified
	| modified |
	modified := self dependencies select: [:dep |
		dep isFulfilled and: [dep package workingCopy modified]].
	
	^modified isEmpty or: [
		self selectDependency: modified anyOne.
		self confirm: (String streamContents: [:strm |
			strm nextPutAll: 'These packages are modified:'; cr.
			modified do: [:dep | strm nextPutAll: dep package name; cr].
			strm nextPutAll: 'Do you still want to store?'])]
	!

----- Method: MCConfigurationBrowser>>checkRepositories (in category 'repositories') -----
checkRepositories
	| bad |
	bad := self repositories reject: [:repo | repo isKindOf: MCHttpRepository].
	^bad isEmpty or: [
		self selectRepository: bad first.
		self inform: (String streamContents: [:strm |
			strm nextPutAll: 'Please remove these repositories:'; cr.
			bad do: [:r | strm nextPutAll: r description; cr].
			strm nextPutAll: '(only HTTP repositories are supported)']).
		false].
!

----- Method: MCConfigurationBrowser>>checkRepositoryTemplates (in category 'repositories') -----
checkRepositoryTemplates
	"unused for now - we only do HTTP"
	| bad |
	bad := self repositories select: [:repo | repo creationTemplate isNil].
	^bad isEmpty or: [
		self selectRepository: bad first.
		self inform: (String streamContents: [:strm |
			strm nextPutAll: 'Creation template missing for'; cr.
			bad do: [:r | strm nextPutAll: r description; cr].
			strm nextPutAll: 'Please fill in the details first!!']).
		false].
!

----- Method: MCConfigurationBrowser>>configuration (in category 'accessing') -----
configuration
	^configuration ifNil: [configuration := MCConfiguration new]!

----- Method: MCConfigurationBrowser>>configuration: (in category 'accessing') -----
configuration: aConfiguration
	configuration := aConfiguration!

----- Method: MCConfigurationBrowser>>defaultExtent (in category 'morphic ui') -----
defaultExtent
	^ 350 at 500!

----- Method: MCConfigurationBrowser>>dependencies (in category 'accessing') -----
dependencies
	^self configuration dependencies
!

----- Method: MCConfigurationBrowser>>dependencies: (in category 'accessing') -----
dependencies: aCollection
	self configuration dependencies: aCollection.
	self changed: #dependencyList; changed: #description
!

----- Method: MCConfigurationBrowser>>dependencyIndex (in category 'selection') -----
dependencyIndex
	^dependencyIndex ifNil: [0]!

----- Method: MCConfigurationBrowser>>dependencyIndex: (in category 'selection') -----
dependencyIndex: anInteger
	dependencyIndex := anInteger.
	dependencyIndex > 0
		ifTrue: [self repositoryIndex: 0].
	self changed: #dependencyIndex; changed: #description.
	self changedButtons.!

----- Method: MCConfigurationBrowser>>dependencyList (in category 'dependencies') -----
dependencyList
	^self dependencies collect: [:dep | 
		Text string: dep versionInfo name
			attributes: (Array streamContents: [:attr |
				dep isFulfilledByAncestors
					ifFalse: [attr nextPut: TextEmphasis bold]
					ifTrue: [dep isCurrent ifFalse: [attr nextPut: TextEmphasis italic]].
			])]
!

----- Method: MCConfigurationBrowser>>dependencyMenu: (in category 'morphic ui') -----
dependencyMenu: aMenu
	self fillMenu: aMenu fromSpecs: #(('add dependency...' addDependency)).
	self selectedDependency ifNotNil: [
		self fillMenu: aMenu fromSpecs: #(('remove dependency...' remove))].
	^aMenu
!

----- Method: MCConfigurationBrowser>>description (in category 'description') -----
description
	self selectedDependency ifNotNil: [:dep | ^ ('Package: ', dep package name, String cr,
		dep versionInfo summary) asText].
	self selectedRepository ifNotNil: [:repo | ^repo creationTemplate
		ifNotNil: [repo creationTemplate asText]
		ifNil: [repo asCreationTemplate asText addAttribute: TextColor red]].
	^ ''
!

----- Method: MCConfigurationBrowser>>description: (in category 'description') -----
description: aText

	self selectedRepository ifNotNil: [:repo | 
		| new | 
		new := MCRepository readFrom: aText asString.
		(new class = repo class 
			and: [new description = repo description])
				ifTrue: [
					repo creationTemplate: aText asString.
					self changed: #description]
				ifFalse: [
					self inform: 'This does not match the previous definition!!'
				]
	].

!

----- Method: MCConfigurationBrowser>>down (in category 'actions') -----
down
	self canMoveDown ifTrue: [
		self list swap: self index with: self index + 1.
		self index: self index + 1.
		self changedList.
	].
!

----- Method: MCConfigurationBrowser>>includesPackage: (in category 'testing') -----
includesPackage: aPackage
	^self dependencies anySatisfy: [:each | each package = aPackage]!

----- Method: MCConfigurationBrowser>>index (in category 'selection') -----
index
	^self dependencyIndex max: self repositoryIndex!

----- Method: MCConfigurationBrowser>>index: (in category 'selection') -----
index: anInteger
	self dependencyIndex > 0 ifTrue: [^self dependencyIndex: anInteger].
	self repositoryIndex > 0 ifTrue: [^self repositoryIndex: anInteger].
	anInteger > 0 ifTrue: [self error: 'cannot select']!

----- Method: MCConfigurationBrowser>>installMenu (in category 'actions') -----
installMenu

	| menu |
	menu := MenuMorph new defaultTarget: self.
	menu add: 'load packages' action: #load.
	menu add: 'merge packages' action: #merge.
	menu add: 'upgrade packages' action: #upgrade.
	menu popUpInWorld.!

----- Method: MCConfigurationBrowser>>list (in category 'selection') -----
list
	self dependencyIndex > 0 ifTrue: [^self dependencies].
	self repositoryIndex > 0 ifTrue: [^self repositories].
	^#()!

----- Method: MCConfigurationBrowser>>load (in category 'actions') -----
load
	self configuration load.
	self changed: #dependencyList; changed: #description
!

----- Method: MCConfigurationBrowser>>loadMenu (in category 'actions') -----
loadMenu

	| menu |
	menu := MenuMorph new defaultTarget: self.
	menu add: 'update from image' action: #updateFromImage.
	menu add: 'update from repositories' action: #updateFromRepositories.
	menu popUpInWorld.
!

----- Method: MCConfigurationBrowser>>maxIndex (in category 'selection') -----
maxIndex
	^ self list size!

----- Method: MCConfigurationBrowser>>merge (in category 'actions') -----
merge
	self configuration merge.
	self changed: #dependencyList; changed: #description
!

----- Method: MCConfigurationBrowser>>pickName (in category 'morphic ui') -----
pickName
	| name |
	name := UIManager default
		request: 'Name (.', self configuration writerClass extension, ' will be appended):'
		initialAnswer: (self configuration name ifNil: ['']).
	^ name isEmpty ifFalse: [name]!

----- Method: MCConfigurationBrowser>>pickRepository (in category 'morphic ui') -----
pickRepository
	^self pickRepositorySatisfying: [:ea | true]
!

----- Method: MCConfigurationBrowser>>pickRepositorySatisfying: (in category 'morphic ui') -----
pickRepositorySatisfying: aBlock
	| index list |
	list := MCRepositoryGroup default repositories select: aBlock.
	index := UIManager default chooseFrom: (list collect: [:ea | ea description])
		title: 'Repository:'.
	^ index = 0 ifFalse: [list at: index]!

----- Method: MCConfigurationBrowser>>pickWorkingCopiesSatisfying: (in category 'morphic ui') -----
pickWorkingCopiesSatisfying: aBlock
	| copies item |
	copies := (MCWorkingCopy allManagers select: aBlock)
		asSortedCollection: [:a :b | a packageName <= b packageName].
	item := UIManager default chooseFrom: #('match ...'),(copies collect: [:ea | ea packageName]) lines: #(1) title: 'Package:'.
	item = 1 ifTrue: [
		| pattern |
		pattern := UIManager default request: 'Packages matching:' initialAnswer: '*'.
		^pattern isEmptyOrNil
			ifTrue: [#()]
			ifFalse: [
				(pattern includes: $*) ifFalse: [pattern := '*', pattern, '*'].
				copies select: [:ea | pattern match: ea packageName]]
	].
	^ item = 0
		ifTrue: [#()]
		ifFalse: [{copies at: item - 1}]!

----- Method: MCConfigurationBrowser>>post (in category 'actions') -----
post
	"Take the current configuration and post an update"
	| name update managers names choice |
	(self checkRepositories and: [self checkDependencies]) ifFalse: [^self].
	name := UIManager default
		request: 'Update name (.cs) will be appended):'
		initialAnswer: (self configuration name ifNil: ['']).
	name isEmpty ifTrue:[^self].
	self configuration name: name.
	update := MCPseudoFileStream on: (String new: 100).
	update localName: name, '.cs'.
	update nextPutAll: '"Change Set:		', name.
	update cr; nextPutAll: 'Date:			', Date today printString.
	update cr; nextPutAll: 'Author:			Posted by Monticello'.
	update cr; cr; nextPutAll: 'This is a configuration map created by Monticello."'.

	update cr; cr; nextPutAll: '(MCConfiguration fromArray: #'.
	self configuration fileOutOn: update.
	update nextPutAll: ') upgrade.'.
	update position: 0.

	managers := Smalltalk at: #UpdateManager ifPresent:[:mgr| mgr allRegisteredManagers].
	managers ifNil:[managers := #()].
	managers size > 0 ifTrue:[
		| servers index |
		servers := ServerDirectory groupNames asSortedArray.
		names := (managers collect:[:each| each packageVersion]), servers.
		index := UIManager default chooseFrom: names lines: {managers size}.
		index = 0 ifTrue:[^self].
		index <= managers size ifTrue:[
			| mgr |
			mgr := managers at: index.
			^mgr publishUpdate: update.
		].
		choice := names at: index.
	] ifFalse:[
		names := ServerDirectory groupNames asSortedArray.
		choice := UIManager default chooseFrom: names values: names.
		choice == nil ifTrue: [^ self].
	].
	(ServerDirectory serverInGroupNamed: choice) putUpdate: update.!

----- Method: MCConfigurationBrowser>>remove (in category 'actions') -----
remove
	self canRemove ifTrue: [
		self list removeAt: self index.
		self changedList.
		self updateIndex.
	].
!

----- Method: MCConfigurationBrowser>>repositories (in category 'accessing') -----
repositories
	^ self configuration repositories!

----- Method: MCConfigurationBrowser>>repositories: (in category 'accessing') -----
repositories: aCollection
	^self configuration repositories: aCollection
!

----- Method: MCConfigurationBrowser>>repositoryIndex (in category 'selection') -----
repositoryIndex
	^repositoryIndex ifNil: [0]!

----- Method: MCConfigurationBrowser>>repositoryIndex: (in category 'selection') -----
repositoryIndex: anInteger
	repositoryIndex := anInteger.
	repositoryIndex > 0
		ifTrue: [self dependencyIndex: 0].
	self changed: #repositoryIndex; changed: #description.
	self changedButtons.!

----- Method: MCConfigurationBrowser>>repositoryList (in category 'repositories') -----
repositoryList
	^self repositories collect: [:ea | ea description]
!

----- Method: MCConfigurationBrowser>>repositoryMenu: (in category 'morphic ui') -----
repositoryMenu: aMenu
	^self fillMenu: aMenu fromSpecs: #(
		('add repository...' addRepository)
	)!

----- Method: MCConfigurationBrowser>>selectDependency: (in category 'selection') -----
selectDependency: aDependency
	self dependencyIndex: (self dependencies indexOf: aDependency)!

----- Method: MCConfigurationBrowser>>selectRepository: (in category 'selection') -----
selectRepository: aRepository
	self repositoryIndex: (self repositories indexOf: aRepository)!

----- Method: MCConfigurationBrowser>>selectedDependency (in category 'dependencies') -----
selectedDependency
	^ self dependencies at: self dependencyIndex ifAbsent: []!

----- Method: MCConfigurationBrowser>>selectedPackage (in category 'dependencies') -----
selectedPackage
	^ self selectedDependency ifNotNil: [:dep | dep package]!

----- Method: MCConfigurationBrowser>>selectedRepository (in category 'repositories') -----
selectedRepository
	^ self repositories at: self repositoryIndex ifAbsent: []!

----- Method: MCConfigurationBrowser>>store (in category 'actions') -----
store
	(self checkRepositories and: [self checkDependencies]) ifFalse: [^self].
	self pickName ifNotNil: [:name |
		self configuration name: name.
		self pickRepository ifNotNil: [:repo |
			repo storeVersion: self configuration]].!

----- Method: MCConfigurationBrowser>>up (in category 'actions') -----
up
	self canMoveUp ifTrue: [
		self list swap: self index with: self index - 1.
		self index: self index - 1.
		self changedList.
	].!

----- Method: MCConfigurationBrowser>>updateFromImage (in category 'updating') -----
updateFromImage
	self configuration updateFromImage.
	self changed: #dependencyList; changed: #description
!

----- Method: MCConfigurationBrowser>>updateFromRepositories (in category 'updating') -----
updateFromRepositories
	self configuration updateFromRepositories.
	self changed: #dependencyList; changed: #description
!

----- Method: MCConfigurationBrowser>>updateIndex (in category 'selection') -----
updateIndex
	self index > 0 ifTrue: [self index: (self index min: self maxIndex)]!

----- Method: MCConfigurationBrowser>>updateMenu (in category 'actions') -----
updateMenu

	| menu |
	menu := MenuMorph new defaultTarget: self.
	menu add: 'update from image' action: #updateFromImage.
	menu add: 'update from repositories' action: #updateFromRepositories.
	menu popUpInWorld.!

----- Method: MCConfigurationBrowser>>upgrade (in category 'actions') -----
upgrade
	self configuration upgrade.
	self changed: #dependencyList; changed: #description
!

----- Method: MCConfigurationBrowser>>widgetSpecs (in category 'morphic ui') -----
widgetSpecs
	^ #(
		((buttonRow) (0 0 1 0) (0 0 0 30))
		((listMorph:selection:menu: dependencyList dependencyIndex dependencyMenu:) (0 0 1 1) (0 30 0 -180))
		((listMorph:selection:menu: repositoryList repositoryIndex repositoryMenu:) (0 1 1 1) (0 -180 0 -120))
		((textMorph: description) (0 1 1 1) (0 -120 0 0))
	 	)!

RWBinaryOrTextStream subclass: #MCPseudoFileStream
	instanceVariableNames: 'localName'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MonticelloConfigurations'!

!MCPseudoFileStream commentStamp: '<historical>' prior: 0!
A pseudo file stream which can be used for updates.!

----- Method: MCPseudoFileStream>>localName (in category 'accessing') -----
localName
	^localName!

----- Method: MCPseudoFileStream>>localName: (in category 'accessing') -----
localName: aString
	localName := aString!

MCWriter subclass: #MCMcmWriter
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MonticelloConfigurations'!

----- Method: MCMcmWriter class>>fileOut:on: (in category 'writing') -----
fileOut: aConfiguration on: aStream
	| inst |
	inst := self on: aStream.
	inst writeConfiguration: aConfiguration.
	inst close.
	
!

----- Method: MCMcmWriter class>>readerClass (in category 'accessing') -----
readerClass
	^ MCMcmReader!

----- Method: MCMcmWriter>>close (in category 'writing') -----
close
	stream close!

----- Method: MCMcmWriter>>writeConfiguration: (in category 'writing') -----
writeConfiguration: aConfiguration

	stream nextPut: $(.

	aConfiguration repositories do: [:ea | 
		stream cr.
		stream nextPutAll: 'repository '.
		(MCConfiguration repositoryToArray: ea) printElementsOn: stream].

	aConfiguration dependencies do: [:ea | 
		stream cr.
		stream nextPutAll: 'dependency '.
		(MCConfiguration dependencyToArray: ea) printElementsOn: stream].

	stream cr.
	stream nextPut: $).
	stream cr.!

Object subclass: #MCConfiguration
	instanceVariableNames: 'name dependencies repositories log'
	classVariableNames: 'DefaultLog ExtraProgressInfo LogToFile'
	poolDictionaries: ''
	category: 'MonticelloConfigurations'!

----- Method: MCConfiguration class>>defaultLog (in category 'accessing') -----
defaultLog
	"Answer the default configuration log"
	^DefaultLog!

----- Method: MCConfiguration class>>defaultLog: (in category 'accessing') -----
defaultLog: aStream
	"Set the default configuration log"
	DefaultLog := aStream.!

----- Method: MCConfiguration class>>dependencyFromArray: (in category 'converting') -----
dependencyFromArray: anArray
	^MCVersionDependency
		package: (MCPackage named: anArray first)
		info: (
			MCVersionInfo
			name: anArray second
			id: (UUID fromString: anArray third)
			message: nil
			date: nil
			time: nil
			author: nil
			ancestors: nil)!

----- Method: MCConfiguration class>>dependencyToArray: (in category 'converting') -----
dependencyToArray: aDependency
	^ {
		aDependency package name . 
		aDependency versionInfo name . 
		aDependency versionInfo id asString }!

----- Method: MCConfiguration class>>extraProgressInfo (in category 'preferences') -----
extraProgressInfo
	"Answer true for additional progress info during load. 
	With the newly added MC down/upload operations this seems unnecessary
	but some people might disagree, so let's leave it as a preference right now"
	<preference: 'Extra Progress Info' 
		category: 'Monticello' 
		description: 'If true, additional progress information is displayed when loading MC configurations (i.e., during updates)' 
		type: #Boolean>
	^ExtraProgressInfo ifNil:[false]!

----- Method: MCConfiguration class>>extraProgressInfo: (in category 'preferences') -----
extraProgressInfo: aBool
	"Whether to display for additional progress info during load."
	ExtraProgressInfo := aBool.
!

----- Method: MCConfiguration class>>fromArray: (in category 'instance creation') -----
fromArray: anArray
	| configuration |
	configuration := self new.
	anArray pairsDo: [:key :value |
		key = #repository
			ifTrue: [configuration repositories add: (self repositoryFromArray: value)].
		key = #dependency
			ifTrue: [configuration dependencies add: (self dependencyFromArray: value)].
	].
	^configuration!

----- Method: MCConfiguration class>>initialize (in category 'class initialization') -----
initialize
	"MCConfiguration initialize"

	Preferences addPreference: #upgradeIsMerge
		categories: #('updates') default: false 
		balloonHelp: 'When upgrading packages, use merge instead of load'.!

----- Method: MCConfiguration class>>logToFile (in category 'preferences') -----
logToFile
	"Whether to log configuration info to files by default.
	If true, logs to a file named after the configuration (config.nn.log).
	If false, logs to the transcript."
	<preference: 'Log config info to disk' 
		category: 'Monticello' 
		description: 'If true, configuration information (such as change logs) are logged to disk instead of the Transcript. The log file is named after the configuration map (config.nn.log)' 
		type: #Boolean>
	^LogToFile ifNil:[true].!

----- Method: MCConfiguration class>>logToFile: (in category 'preferences') -----
logToFile: aBool
	"Whether to log configuration info to files by default.
		MCConfiguration logToFile: true.
		MCConfiguration logToFile: false.
	"
	LogToFile := aBool!

----- Method: MCConfiguration class>>repositoryFromArray: (in category 'converting') -----
repositoryFromArray: anArray
	^ MCRepositoryGroup default repositories
		detect: [:repo | repo description = anArray first]
		ifNone: [
			MCHttpRepository
				location: anArray first
				user: ''
				password: '']!

----- Method: MCConfiguration class>>repositoryToArray: (in category 'converting') -----
repositoryToArray: aRepository
	^ {aRepository description}!

----- Method: MCConfiguration>>browse (in category 'actions') -----
browse
	(MCConfigurationBrowser new configuration: self) show!

----- Method: MCConfiguration>>changes (in category 'faking') -----
changes
	^MCPatch operations: #()!

----- Method: MCConfiguration>>dependencies (in category 'accessing') -----
dependencies
	^dependencies ifNil: [dependencies := OrderedCollection new]!

----- Method: MCConfiguration>>dependencies: (in category 'accessing') -----
dependencies: aCollection
	dependencies := aCollection!

----- Method: MCConfiguration>>depsSatisfying:versionDo:displayingProgress: (in category 'private') -----
depsSatisfying: selectBlock versionDo: verBlock displayingProgress: progressString
	| repoMap count action |
	repoMap := Dictionary new.
	self repositories do: [:repo |
		MCRepositoryGroup default addRepository: repo.
		repo allVersionNames
			ifEmpty: [self logWarning: 'cannot read from ', repo description]
			ifNotEmptyDo: [:all | all do: [:ver | repoMap at: ver put: repo]]].

	count := 0.
	action := [:dep |
		| ver repo |
		ver := dep versionInfo name.
		repo := repoMap at: ver ifAbsent: [
			self logError: 'Version ', ver, ' not found in any repository'.
			self logError: 'Aborting'.
			^count].
		(selectBlock value: dep) ifTrue: [
			| new |
			new := self versionNamed: ver for: dep from: repo.
			new ifNil: [
					self logError: 'Could not download version ', ver, ' from ', repo description.
					self logError: 'Aborting'.
					^count]
				ifNotNil: [
					self logUpdate: dep package with: new.
					self class extraProgressInfo
						ifTrue:[ProgressNotification signal: '' extra: 'Installing ', ver].
					verBlock value: new.
					count := count + 1.
				]
		].
		dep package workingCopy repositoryGroup addRepository: repo.
	].
	self class extraProgressInfo 
		ifTrue:[self dependencies do: action displayingProgress: progressString]
		ifFalse:[self dependencies do: action].
	^count!

----- Method: MCConfiguration>>diffBaseFor: (in category 'private') -----
diffBaseFor: aDependency
	| wc |
	aDependency package hasWorkingCopy ifFalse: [^nil].
	wc := aDependency package workingCopy.
	wc ancestors ifEmpty: [^nil].
	^wc ancestors first name!

----- Method: MCConfiguration>>fileName (in category 'accessing') -----
fileName
	^ self name, '.', self writerClass extension
!

----- Method: MCConfiguration>>fileOutOn: (in category 'actions') -----
fileOutOn: aStream
	self writerClass fileOut: self on: aStream!

----- Method: MCConfiguration>>info (in category 'faking') -----
info
	^MCVersionInfo new!

----- Method: MCConfiguration>>initialize (in category 'initialize') -----
initialize
	super initialize.
	log := DefaultLog.!

----- Method: MCConfiguration>>isCacheable (in category 'testing') -----
isCacheable
	^false!

----- Method: MCConfiguration>>load (in category 'actions') -----
load
	^self depsSatisfying: [:dep | dep isCurrent not]
		versionDo: [:ver | ver load]
		displayingProgress: 'loading packages'
!

----- Method: MCConfiguration>>log (in category 'accessing') -----
log
	"Answer the receiver's log. If no log exist use the default log"
	
	^log ifNil: [
		(name notNil and: [ self class logToFile ]) ifFalse: [ 
			Transcript countOpenTranscripts = 0 ifTrue: [Transcript open].
			^Transcript ].
		self log: ((FileStream fileNamed: self logFileName) setToEnd; yourself).
		log ]!

----- Method: MCConfiguration>>log: (in category 'accessing') -----
log: aStream
	log := aStream.!

----- Method: MCConfiguration>>logError: (in category 'private') -----
logError: aString
	self log
		cr; nextPutAll: 'ERROR: ';
		nextPutAll: aString; cr;
		flush.
!

----- Method: MCConfiguration>>logFileName (in category 'accessing') -----
logFileName

	^self name, '-', (FileDirectory localNameFor: SmalltalkImage current imageName), '.log'
	!

----- Method: MCConfiguration>>logUpdate:with: (in category 'private') -----
logUpdate: aPackage with: aVersion
	self log
		cr; nextPutAll: '========== ', aVersion info name, ' =========='; cr;
		cr; nextPutAll: aVersion info message asString; cr;
		flush.

	aPackage hasWorkingCopy ifFalse: [^self].

	aPackage workingCopy ancestors do: [:each |
		(aVersion info hasAncestor: each)
			ifTrue: [(aVersion info allAncestorsOnPathTo: each)
				do: [:ver | self log cr; nextPutAll: '>>> ', ver name, ' <<<'; cr;
							nextPutAll: ver message; cr; flush]]]!

----- Method: MCConfiguration>>logWarning: (in category 'private') -----
logWarning: aString
	self log
		cr; nextPutAll: 'WARNING: ';
		nextPutAll: aString; cr;
		flush.
!

----- Method: MCConfiguration>>merge (in category 'actions') -----
merge
	^self depsSatisfying: [:dep | dep isFulfilledByAncestors not]
		versionDo: [:ver | ver merge]
		displayingProgress: 'merging packages'
!

----- Method: MCConfiguration>>mustMerge: (in category 'private') -----
mustMerge: aVersion
	"answer true if we have to do a full merge and false if we can simply load instead"
	
	| pkg wc current |
	(pkg := aVersion package) hasWorkingCopy ifFalse: [^false "no wc -> load"].
	(wc := pkg workingCopy) modified ifTrue: [^true "modified -> merge"].
	wc ancestors isEmpty ifTrue: [^true "no ancestor info -> merge"].
	current := wc ancestors first.
	(aVersion info hasAncestor: current) ifTrue: [^false "direct descendant of wc -> load"].
	"new branch -> merge"
	^true!

----- Method: MCConfiguration>>name (in category 'accessing') -----
name
	^name!

----- Method: MCConfiguration>>name: (in category 'accessing') -----
name: aString
	name := aString!

----- Method: MCConfiguration>>repositories (in category 'accessing') -----
repositories
	^repositories ifNil: [repositories := OrderedCollection new]!

----- Method: MCConfiguration>>repositories: (in category 'accessing') -----
repositories: aCollection
	repositories := aCollection!

----- Method: MCConfiguration>>summary (in category 'accessing') -----
summary
	^String streamContents: [:stream |
		self dependencies
			do: [:ea | stream nextPutAll: ea versionInfo name; cr ]]!

----- Method: MCConfiguration>>updateFromImage (in category 'updating') -----
updateFromImage
	self dependencies: (self dependencies collect: [:dep |
		dep package hasWorkingCopy
			ifTrue: [
				dep package workingCopy in: [:wc |
					MCVersionDependency package: wc package info: wc ancestors first]]
			ifFalse: [dep]]).
!

----- Method: MCConfiguration>>updateFromRepositories (in category 'updating') -----
updateFromRepositories
	| oldInfos newNames sortedNames newDeps |
	oldInfos := self dependencies collect: [:dep | dep versionInfo].
	newNames := Dictionary new.
	self repositories
		do: [:repo | 
			ProgressNotification signal: '' extra: 'Checking ', repo description.
			(repo possiblyNewerVersionsOfAnyOf: oldInfos)
				do: [:newName | newNames at: newName put: repo]]
		displayingProgress: 'Searching new versions'.

	sortedNames := newNames keys asArray sort:
		[:a :b | a numericSuffix > b numericSuffix].

	newDeps := OrderedCollection new.
	self dependencies do: [:dep |
		| newName |
		newName := sortedNames
			detect: [:each | (each copyUpToLast: $-) = dep package name]
			ifNone: [nil].
		newDeps add: (newName
			ifNil: [dep]
			ifNotNil: [
				| repo info  |
				repo := newNames at: newName.
				info := self versionInfoNamed: newName for: dep from: repo.
				info ifNil: [dep]
					ifNotNil: [MCVersionDependency package: dep package info: info]
			])
	] displayingProgress: 'downloading new versions'.

	self dependencies: newDeps.
!

----- Method: MCConfiguration>>upgrade (in category 'actions') -----
upgrade
	^self depsSatisfying: [:dep | dep isFulfilledByAncestors not]
		versionDo: [:ver | 
			(Preferences upgradeIsMerge and: [self mustMerge: ver])
				ifFalse: [ver load]
				ifTrue: [[ver merge]
					on: MCMergeResolutionRequest do: [:request |
						request merger conflicts isEmpty
							ifTrue: [request resume: true]
							ifFalse: [request pass]]]]
		displayingProgress: 'upgrading packages'
!

----- Method: MCConfiguration>>versionInfoNamed:for:from: (in category 'private') -----
versionInfoNamed: newName for: dep from: repo
	"Retrieves the version info instead of the version. Searches in-image first, in case the desired version is part of an already loaded package (usual case when doing a partial update). If not present defaults to versionNamed:for:from: an uses its result."
	MCWorkingCopy registry at: dep package ifPresent:[:workingCopy| | seen |
		"Don't use allAncestorsDo: - apparently this can loop indefinitely.
		Rather keep track of the versions that we've seen and make sure we don't loop."
		seen := Set new.
		workingCopy ancestry ancestorsDoWhileTrue:[:vInfo|
			vInfo name = newName ifTrue:[^vInfo].
			(seen includes: vInfo) ifTrue:[false] ifFalse:[seen add: vInfo. false]
		].
	].
	^(self versionNamed: newName for: dep from: repo) info!

----- Method: MCConfiguration>>versionNamed:for:from: (in category 'private') -----
versionNamed: verName for: aDependency from: repo

	| baseName fileName ver |
	(repo filterFileNames: repo cachedFileNames forVersionNamed: verName) ifNotEmptyDo: [:cachedNames |
		fileName := cachedNames anyOne.
		self class extraProgressInfo
			ifTrue:[ProgressNotification signal: '' extra: 'Using cached ', fileName].
		ver := repo versionFromFileNamed: fileName].
	ver ifNil: [
		baseName := self diffBaseFor: aDependency.
		(baseName notNil and: [baseName ~= verName and: [repo includesVersionNamed: baseName]]) ifTrue: [
			fileName := (MCDiffyVersion nameForVer: verName base: baseName), '.mcd'.
			self class extraProgressInfo
				ifTrue:[ProgressNotification signal: '' extra: 'Downloading ', fileName].
			ver := repo versionFromFileNamed: fileName]].
	ver ifNil: [
		fileName := verName, '.mcz'.
		self class extraProgressInfo
			ifTrue:[ProgressNotification signal: '' extra: 'Downloading ', fileName].
		ver := repo versionFromFileNamed: fileName].
	^ver!

----- Method: MCConfiguration>>writerClass (in category 'accessing') -----
writerClass
	^ MCMcmWriter !

Object subclass: #MCMcmUpdater
	instanceVariableNames: ''
	classVariableNames: 'DefaultUpdateURL LastUpdateMap'
	poolDictionaries: ''
	category: 'MonticelloConfigurations'!

----- Method: MCMcmUpdater class>>defaultUpdateURL (in category 'updating') -----
defaultUpdateURL
	"The default update repository URL"

	<preference: 'Update URL'
		category: 'Monticello'
		description: 'The repository URL for loading updates'
		type: #String>

	^DefaultUpdateURL ifNil:['']!

----- Method: MCMcmUpdater class>>defaultUpdateURL: (in category 'updating') -----
defaultUpdateURL: aString
	"The default update repository URL"

	DefaultUpdateURL := aString!

----- Method: MCMcmUpdater class>>initialize (in category 'class initialization') -----
initialize
	"MCMcmUpdater initialize"
	LastUpdateMap ifNil:[
		LastUpdateMap := Dictionary new.
	].
	DefaultUpdateURL ifNil:[
		DefaultUpdateURL := 'http://source.squeak.org/trunk'.
	].!

----- Method: MCMcmUpdater class>>updateFromDefaultRepository (in category 'updating') -----
updateFromDefaultRepository
	"Update from the default repository only"
	^self updateFromRepositories: {self defaultUpdateURL}!

----- Method: MCMcmUpdater class>>updateFromRepositories: (in category 'updating') -----
updateFromRepositories: repositoryUrls
	"MCMcmUpdater updateFromRepositories: #(
		'http://squeaksource.com/MCUpdateTest'
	)"

	| repos config |
	Preferences enable: #upgradeIsMerge.
	LastUpdateMap ifNil:[LastUpdateMap := Dictionary new].
	"The list of repositories to consult in order"
	repos := repositoryUrls collect:[:url| 
		MCRepositoryGroup default repositories 
			detect:[:r| r description = url]
			ifNone:[ | r |
				r := MCHttpRepository location: url user: '' password: ''.
				MCRepositoryGroup default addRepository: r.
				r]].

	"The list of updates-author.version.mcm sorted by version"
	repos do:[:r| r cacheAllFileNamesDuring:[
		| minVersion updateList allNames |
		updateList := SortedCollection new.
		minVersion := LastUpdateMap at: r description ifAbsent:[0].
		"Find all the updates-author.version.mcm files"
		'Checking ', r description
			displayProgressAt: Sensor cursorPoint
			from: 0 to: 1 during:[:bar| 
				bar value: 0.
				allNames := r allFileNames.
			].
		allNames do:[:versionedName| | version base parts author type |
			parts := versionedName findTokens: '.-'.
			parts size = 4 ifTrue:[
				base := parts at: 1.
				author := parts at: 2.
				version := [(parts at: 3) asNumber] on: Error do:[:ex| ex return: 0].
				type := parts at: 4.
			].
			(base = 'update' and:[version >= minVersion and:[type = 'mcm']]) 
				ifTrue:[updateList add: version -> versionedName]].
		
		"Proceed only if there are updates available at all."
		updateList ifNotEmpty: [
			"Now process each update file. Check if we have all dependencies and if not,
			load the entire configuration (this is mostly to skip older updates quickly)"
			updateList do:[:assoc|
				ProgressNotification signal: '' extra: 'Processing ', assoc value.
				config := r versionFromFileNamed: assoc value.
				(config dependencies allSatisfy:[:dep| dep isFulfilled]) 
					ifFalse:[config upgrade].
				LastUpdateMap at: r description put: assoc key.
			] displayingProgress: 'Processing configurations'.
			"We've loaded all the provided update configurations.
			Use the latest configuration to update all the remaining packages."
			config updateFromRepositories.
			config upgrade.
		]].
	].
	^config!

MCVersionReader subclass: #MCMcmReader
	instanceVariableNames: 'fileName configuration'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MonticelloConfigurations'!

----- Method: MCMcmReader class>>extension (in category 'accessing') -----
extension
	^ 'mcm'!

----- Method: MCMcmReader class>>loadVersionFile: (in category 'instance creation') -----
loadVersionFile: fileName
	| version |
	version := self versionFromFile: fileName.
	version load.
!

----- Method: MCMcmReader class>>on:fileName: (in category 'instance creation') -----
on: aStream fileName: aFileName
	| reader |
	reader := self on: aStream.
	reader fileName: aFileName.
	^reader!

----- Method: MCMcmReader>>configuration (in category 'accessing') -----
configuration
	configuration ifNil: [self loadConfiguration].
	"browser modifies configuration, but the reader might get cached"
	^configuration copy!

----- Method: MCMcmReader>>configurationName (in category 'accessing') -----
configurationName
	^fileName ifNotNil: [(fileName findTokens: '/\:') last copyUpToLast: $.]!

----- Method: MCMcmReader>>fileName: (in category 'accessing') -----
fileName: aString
	fileName := aString!

----- Method: MCMcmReader>>loadConfiguration (in category 'accessing') -----
loadConfiguration
	stream reset.
	configuration := MCConfiguration fromArray: (MCScanner scan: stream).
	configuration name: self configurationName.
!

----- Method: MCMcmReader>>loadVersionInfo (in category 'accessing') -----
loadVersionInfo
	info := self configuration!

----- Method: MCMcmReader>>version (in category 'accessing') -----
version
	^self configuration!