[squeak-dev] The Inbox: MonticelloConfigurations-mt.179.mczcommits at source.squeak.org commits at source.squeak.orgThu Jul 14 14:11:06 UTC 2022
A new version of MonticelloConfigurations was added to project The Inbox: http://source.squeak.org/inbox/MonticelloConfigurations-mt.179.mcz ==================== Summary ==================== Name: MonticelloConfigurations-mt.179 Author: mt Time: 2 July 2022, 11:26:29.792753 am UUID: 7e551122-54fa-2842-bde7-286931b40d4f Ancestors: MonticelloConfigurations-dtl.178 Fixes HTTP-vs-HTTPS confusion during MC updates so that we can migrate from HTTP to HTTPS without having to download every .mcm there has ever been again. =============== Diff against MonticelloConfigurations-dtl.178 =============== Item was removed: - SystemOrganization addCategory: #MonticelloConfigurations! Item was removed: - Object subclass: #MCConfiguration - instanceVariableNames: 'name dependencies repositories log' - classVariableNames: 'DefaultLog EnsureOpenTranscript ExtraProgressInfo LogToFile UpgradeIsMerge' - poolDictionaries: '' - category: 'MonticelloConfigurations'! - - !MCConfiguration commentStamp: 'dtl 5/10/2010 23:03' prior: 0! - An MCConfiguration specifies the configuration of a set of related Monticello packages. It maintains an ordered list of package versions and a list of repositories in which the packages may be found. - - An MCConfiguration may be filed out for storage as an array specification, and new instances can be created from a stored array specification. - ! Item was removed: - ----- Method: MCConfiguration class>>concreteClassFor: (in category 'private') ----- - concreteClassFor: configArray - ^ (configArray includes: #mcmVersion) - ifTrue: [MCConfigurationExtended] - ifFalse: [MCConfiguration]. - - ! Item was removed: - ----- Method: MCConfiguration class>>copyWithoutKeyPrefix: (in category 'private') ----- - copyWithoutKeyPrefix: configArray - "Tokens in the version history portion of configArray are prefixed with $X to - prevent them being parsed in the original implementation of MCConfiguration. - Here we remove the prefixes prior to processing in the current implementation - with MCConfigurationExtended support. See #contentsOn:keyPrefix: for the - prefix writer." - | strm | - strm := #() writeStream. - configArray do: [ :token | - token caseOf: { - [#Xname ] -> [ strm nextPut: #name] . - [#Xrepository ] -> [ strm nextPut: #repository] . - [#Xdependency ] -> [ strm nextPut: #dependency] . - [#XmcmVersion] -> [ strm nextPut: #mcmVersion] . - [#Xid] -> [ strm nextPut: #id] . - [#XauthorInitials ] -> [ strm nextPut: #authorInitials] . - [#XtimeStamp ] -> [ strm nextPut: #timeStamp] . - [#Xcomment ] -> [ strm nextPut: #comment] - } - otherwise: [ strm nextPut: token] - - - ]. - ^ strm contents. - - ! Item was removed: - ----- Method: MCConfiguration class>>defaultLog (in category 'accessing') ----- - defaultLog - "Answer the default configuration log" - ^DefaultLog! Item was removed: - ----- Method: MCConfiguration class>>defaultLog: (in category 'accessing') ----- - defaultLog: aStream - "Set the default configuration log" - DefaultLog := aStream.! Item was removed: - ----- 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)! Item was removed: - ----- Method: MCConfiguration class>>dependencyToArray: (in category 'converting') ----- - dependencyToArray: aDependency - ^ { - aDependency package name . - aDependency versionInfo name . - aDependency versionInfo id asString }! Item was removed: - ----- Method: MCConfiguration class>>ensureOpenTranscript (in category 'preferences') ----- - ensureOpenTranscript - - <preference: 'Ensure Open Transcript' - category: 'Monticello' - description: 'When logging, a transcript will be opened automatically if no one is visible. This setting has no effect when logging to a file.' - type: #Boolean> - - ^EnsureOpenTranscript ifNil:[true]! Item was removed: - ----- Method: MCConfiguration class>>ensureOpenTranscript: (in category 'preferences') ----- - ensureOpenTranscript: aBoolean - - EnsureOpenTranscript := aBoolean.! Item was removed: - ----- 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]! Item was removed: - ----- Method: MCConfiguration class>>extraProgressInfo: (in category 'preferences') ----- - extraProgressInfo: aBool - "Whether to display for additional progress info during load." - ExtraProgressInfo := aBool. - ! Item was removed: - ----- Method: MCConfiguration class>>fromArray: (in category 'instance creation') ----- - fromArray: anArray - | array | - array := self copyWithoutKeyPrefix: anArray. - ^ (self versionsFromStream: array readStream) first. - ! Item was removed: - ----- Method: MCConfiguration class>>logToFile (in category 'preferences') ----- - logToFile - <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: [false]! Item was removed: - ----- 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! Item was removed: - ----- Method: MCConfiguration class>>nextArrayFrom: (in category 'private') ----- - nextArrayFrom: configStream - "Each config array starts with #name. The appearance of another token of - that value indicates the beginning of a new configuration map for a prior - version of the configuration." - | oc | - oc := OrderedCollection new. - oc add: configStream next. - [configStream atEnd not and: [#name ~= configStream peek]] - whileTrue: [oc add: configStream next]. - ^ oc - ! Item was removed: - ----- Method: MCConfiguration class>>nextFrom: (in category 'private') ----- - nextFrom: configStream - - | configArray configuration | - configArray := self nextArrayFrom: configStream. - configuration := (self concreteClassFor: configArray) new. - configArray pairsDo: [:key :value | - configuration initializeFromKey: key value: value]. - ^ configuration. - ! Item was removed: - ----- Method: MCConfiguration class>>oldVersionOfFromArray: (in category 'private') ----- - oldVersionOfFromArray: anArray - "For verifying backward compatability. This is the implementation - of #fromArray: prior to introduction of MCConfigurationExtended." - | 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)]. - key = #name - ifTrue: [configuration name: value]. - ]. - ^configuration! Item was removed: - ----- 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: '']! Item was removed: - ----- Method: MCConfiguration class>>repositoryToArray: (in category 'converting') ----- - repositoryToArray: aRepository - ^ {aRepository description}! Item was removed: - ----- Method: MCConfiguration class>>upgradeIsMerge (in category 'preferences') ----- - upgradeIsMerge - "Answer true if you wish to merge upstream changes whenever you upgrade." - <preference: 'Upgrade is merge' - category: 'updates' - description: 'When upgrading packages, use merge instead of load' - type: #Boolean> - ^UpgradeIsMerge ifNil: [true]! Item was removed: - ----- Method: MCConfiguration class>>upgradeIsMerge: (in category 'preferences') ----- - upgradeIsMerge: aBoolean - UpgradeIsMerge := aBoolean.! Item was removed: - ----- Method: MCConfiguration class>>versionsFromStream: (in category 'private') ----- - versionsFromStream: arrayStream - "Answer all versions with history list populated in each version." - | configuration history | - arrayStream atEnd ifTrue: [ ^ #() ]. - configuration := self nextFrom: arrayStream. - history := self versionsFromStream: arrayStream. - history do: [ :ver | configuration addPriorVersion: ver ]. - ^ { configuration }, history. - ! Item was removed: - ----- Method: MCConfiguration>>= (in category 'comparing') ----- - = configuration - ^ ((configuration class = self class - and: [configuration name = name]) - and: [configuration dependencies = dependencies]) - and: [configuration repositories = repositories]! Item was removed: - ----- Method: MCConfiguration>>addPriorVersion: (in category 'initialize') ----- - addPriorVersion: mcConfig - "Do nothing, the original MCConfiguration format does not maintain history"! Item was removed: - ----- Method: MCConfiguration>>browse (in category 'actions') ----- - browse - | browser | - browser := MCConfigurationBrowser new configuration: self copyForEdit. - name ifNotNil: [:nm | browser label: browser defaultLabel , ' ' , nm]. - browser show! Item was removed: - ----- Method: MCConfiguration>>cacheAllFileNamesDuring: (in category 'private') ----- - cacheAllFileNamesDuring: aBlock - ^ (repositories - inject: aBlock - into: [ :innerBlock :repository | - [ repository cacheAllFileNamesDuring: innerBlock ] - ]) value - - ! Item was removed: - ----- Method: MCConfiguration>>changes (in category 'faking') ----- - changes - ^MCPatch operations: #()! Item was removed: - ----- Method: MCConfiguration>>contentsOn: (in category 'printing') ----- - contentsOn: aStream - self contentsOn: aStream keyPrefix: ''. - ! Item was removed: - ----- Method: MCConfiguration>>contentsOn:keyPrefix: (in category 'printing') ----- - contentsOn: aStream keyPrefix: prefix - "Prepend prefix to key values. If the prefix is a non-empty string, the resulting - key values will be ignored when parsing an original format MCConfiguration - from an extended format MCM file. This provides backward compatibility for - older images that need to read newer format MCM files." - - name ifNotNil: [:n | - aStream cr. - aStream nextPutAll: prefix,'name '. - aStream print: n]. - - repositories do: [:ea | - aStream cr. - aStream nextPutAll: prefix,'repository '. - (MCConfiguration repositoryToArray: ea) printElementsOn: aStream]. - - dependencies do: [:ea | - aStream cr. - aStream nextPutAll: prefix,'dependency '. - (MCConfiguration dependencyToArray: ea) printElementsOn: aStream]. - ! Item was removed: - ----- Method: MCConfiguration>>copyForEdit (in category 'copying') ----- - copyForEdit - "Preparing to edit a configuration. Answer a new copy with the original - instance saved in version history, and with no author initials or timestamp. - The initials and timestamp are to be set immediately prior to saving an edited - version." - | config | - config := MCConfigurationExtended new. - config name: name copy. - config dependencies: dependencies copy. - config repositories: repositories copy. - config priorVersions addFirst: self. - ^ config! Item was removed: - ----- Method: MCConfiguration>>copyWithoutHistory (in category 'copying') ----- - copyWithoutHistory - ^ self copy - ! Item was removed: - ----- Method: MCConfiguration>>dependencies (in category 'accessing') ----- - dependencies - ^dependencies ifNil: [dependencies := OrderedCollection new]! Item was removed: - ----- Method: MCConfiguration>>dependencies: (in category 'accessing') ----- - dependencies: aCollection - dependencies := aCollection! Item was removed: - ----- Method: MCConfiguration>>depsSatisfying:versionDo:displayingProgress: (in category 'private') ----- - depsSatisfying: selectBlock versionDo: verBlock displayingProgress: progressString - | count selectedVersions cleanWorkingCopies | - self cacheAllFileNamesDuring: [ - self repositories do: [ :eachRepository | - MCRepositoryGroup default addRepository: eachRepository ]. - "First, download selected versions" - count := 0. - selectedVersions := OrderedCollection new. - self withProgress: progressString in: self dependencies do: [ :dep | | verName repo | - verName := dep versionInfo name. - self class extraProgressInfo ifTrue: - [ ProgressNotification signal: '' extra: ('Downloading {1}' translated format: {verName}) ]. - repo := self repositories - detect: [ :eachRepository | eachRepository includesVersionNamed: verName ] - ifNone: [ self logError: ('Version {1} not found in any repository' translated format: {verName}). - self logError: 'Aborting' translated. - ^ count ]. - (selectBlock value: dep) ifTrue: [ | version | - version := self versionNamed: verName for: dep from: repo. - version ifNil: [ self logError: ('Could not download version {1} from {2}' translated format: {verName. repo description}). - self logError: 'Aborting' translated. - ^ count ]. - dep package workingCopy newRepositoryGroupIfDefault. "fix old working copies" - dep package workingCopy repositoryGroup addRepository: repo. - selectedVersions add: version]]. - "Then, process only those definitions that moved from one package to another, to avoid order dependence" - cleanWorkingCopies := MCWorkingCopy allManagers select: - [ :wc | wc modified not and: - [ selectedVersions anySatisfy: [ :v | wc package = v package ] ] ]. - MCReorganizationPreloader preloadMovesBetween: selectedVersions. - "Finally, load/merge selected versions" - self withProgress: progressString in: selectedVersions do: [ :version | - self logUpdate: version package with: version. - self class extraProgressInfo ifTrue: - [ ProgressNotification signal: '' extra: ('Installing {1}' translated format: {version info name}) ]. - verBlock value: version. - count := count + 1 ]. - "Clean up packages made dirty by MCReorganizationPreloader" - cleanWorkingCopies - select: [ :wc | wc modified ] - thenDo: [ :wc | wc checkModified ]. - ]. - ^ count! Item was removed: - ----- 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 versionName! Item was removed: - ----- Method: MCConfiguration>>fileName (in category 'accessing') ----- - fileName - ^ self name, '.', self writerClass extension - ! Item was removed: - ----- Method: MCConfiguration>>fileOutOn: (in category 'printing') ----- - fileOutOn: aStream - self fileOutOn: aStream keyPrefix: '' - ! Item was removed: - ----- Method: MCConfiguration>>fileOutOn:keyPrefix: (in category 'printing') ----- - fileOutOn: aStream keyPrefix: prefix - - aStream nextPut: $(. - self contentsOn: aStream keyPrefix: prefix. - aStream cr. - aStream nextPut: $). - ! Item was removed: - ----- Method: MCConfiguration>>hash (in category 'comparing') ----- - hash - ^ (name hash bitXor: (dependencies hash)) bitXor: repositories hash - ! Item was removed: - ----- Method: MCConfiguration>>info (in category 'faking') ----- - info - ^MCVersionInfo new! Item was removed: - ----- Method: MCConfiguration>>initialize (in category 'initialize') ----- - initialize - super initialize. - log := DefaultLog.! Item was removed: - ----- Method: MCConfiguration>>initializeFromKey:value: (in category 'initialize') ----- - initializeFromKey: key value: value - key = #repository - ifTrue: [self repositories add: (MCConfiguration repositoryFromArray: value)]. - key = #dependency - ifTrue: [self dependencies add: (MCConfiguration dependencyFromArray: value)]. - key = #name - ifTrue: [self name: value]. - ! Item was removed: - ----- Method: MCConfiguration>>isCacheable (in category 'testing') ----- - isCacheable - ^false! Item was removed: - ----- Method: MCConfiguration>>load (in category 'actions') ----- - load - ^self depsSatisfying: [:dep | dep isCurrent not] - versionDo: [:ver | ver load] - displayingProgress: 'loading packages' translated! Item was removed: - ----- 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: [ - self class ensureOpenTranscript ifTrue: [Transcript openIfNone]. - ^Transcript ]. - self log: ((FileStream fileNamed: self logFileName) setToEnd; yourself). - log ]! Item was removed: - ----- Method: MCConfiguration>>log: (in category 'accessing') ----- - log: aStream - log := aStream.! Item was removed: - ----- Method: MCConfiguration>>logError: (in category 'private') ----- - logError: aString - self log - cr; nextPutAll: 'ERROR: '; - nextPutAll: aString; cr; - flush. - ! Item was removed: - ----- Method: MCConfiguration>>logFileName (in category 'accessing') ----- - logFileName - - ^self name, '-', (FileDirectory localNameFor: Smalltalk imageName), '.log' - ! Item was removed: - ----- 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]]]! Item was removed: - ----- Method: MCConfiguration>>logWarning: (in category 'private') ----- - logWarning: aString - self log - cr; nextPutAll: 'WARNING: '; - nextPutAll: aString; cr; - flush. - ! Item was removed: - ----- Method: MCConfiguration>>merge (in category 'actions') ----- - merge - ^self depsSatisfying: [:dep | dep isFulfilledByAncestors not] - versionDo: [:ver | ver merge] - displayingProgress: 'merging packages' translated! Item was removed: - ----- 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! Item was removed: - ----- Method: MCConfiguration>>name (in category 'accessing') ----- - name - ^name! Item was removed: - ----- Method: MCConfiguration>>name: (in category 'accessing') ----- - name: aString - name := aString! Item was removed: - ----- Method: MCConfiguration>>repositories (in category 'accessing') ----- - repositories - ^repositories ifNil: [repositories := OrderedCollection new]! Item was removed: - ----- Method: MCConfiguration>>repositories: (in category 'accessing') ----- - repositories: aCollection - repositories := aCollection! Item was removed: - ----- Method: MCConfiguration>>setSystemVersion (in category 'updating') ----- - setSystemVersion - "Set the current system version date to the latest date found in my configuration (or the associated working copy). Also set the highest update number to the sum of version numbers in my configuration." - - | versionNumbers versionDates | - versionNumbers := self dependencies collect: [:d | - (d versionInfo name copyAfterLast: $.) asInteger]. - versionDates := self dependencies collect: [:d | - d versionInfo date - ifNil: [d package workingCopy ancestors first date]]. - SystemVersion current - date: versionDates max; - highestUpdate: versionNumbers sum.! Item was removed: - ----- Method: MCConfiguration>>storeOn: (in category 'printing') ----- - storeOn: aStream - aStream nextPut: $(; - nextPutAll: self class name; - nextPutAll: ' fromArray: #'. - self fileOutOn: aStream. - aStream nextPut: $)! Item was removed: - ----- Method: MCConfiguration>>suggestedNameOfNextVersion (in category 'private') ----- - suggestedNameOfNextVersion - "Suggest a name for the next version of this configuration. The format is assumed to be name-authorInitials.version. Automatically increments the version, takes author initials from Utilities." - ^'{1}-{2}.{3}' format: { - name - ifNil: [ 'newConfiguration' ] - ifNotNil: [ name asMCVersionName packageAndBranchName ]. - Utilities authorInitials. - name - ifNil: [ 1 ] - ifNotNil: [ name asMCVersionName versionNumber + 1 ] }! Item was removed: - ----- Method: MCConfiguration>>summary (in category 'accessing') ----- - summary - ^String streamContents: [:stream | - self dependencies - do: [:ea | stream nextPutAll: ea versionInfo name; cr ]]! Item was removed: - ----- 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]]). - ! Item was removed: - ----- Method: MCConfiguration>>updateFromImage: (in category 'updating') ----- - updateFromImage: packageIndex - | dep newDeps | - dep := self dependencies at: packageIndex. - newDeps := self dependencies copy. - newDeps - at: packageIndex put: (dep package hasWorkingCopy - ifTrue: [dep package workingCopy in: [:wc | - MCVersionDependency package: wc package info: wc ancestors first]] - ifFalse: [dep]). - self dependencies: newDeps. - ! Item was removed: - ----- Method: MCConfiguration>>updateFromRepositories (in category 'updating') ----- - updateFromRepositories - - self cacheAllFileNamesDuring: [ self updateFromRepositoriesWithoutCaching ]! Item was removed: - ----- Method: MCConfiguration>>updateFromRepositories: (in category 'updating') ----- - updateFromRepositories: packageIndex - - self cacheAllFileNamesDuring: [ self updateFromRepositoriesWithoutCaching: packageIndex ]! Item was removed: - ----- Method: MCConfiguration>>updateFromRepositoriesWithoutCaching (in category 'updating') ----- - updateFromRepositoriesWithoutCaching - - | oldNames newNames sortedNames newDeps | - oldNames := self dependencies collect: [:dep | dep versionInfo versionName]. - newNames := Dictionary new. - self repositories - do: [:repo | - ProgressNotification signal: '' extra: ('Checking {1}' translated format: {repo description}). - (repo possiblyNewerVersionsOfAnyOf: oldNames) - do: [:newName | newNames at: newName put: repo]] - displayingProgress: 'Searching new versions' translated. - - sortedNames := newNames keys asArray sort: - [:a :b | a versionNumber > b versionNumber]. - - newDeps := OrderedCollection new: self dependencies size. - self dependencies - do: [:dep | - newDeps add: (sortedNames - detect: [:each | each packageAndBranchName = dep packageAndBranchName] - ifFound: [ :newName | - | repo | - repo := newNames at: newName. - (self versionInfoNamed: newName for: dep from: repo) - ifNil: [ dep ] - ifNotNil: [ :info | - MCVersionDependency package: dep package info: info ] ] - ifNone: [ dep ]) ] - displayingProgress: 'Downloading new versions ...' translated. - - self dependencies: newDeps.! Item was removed: - ----- Method: MCConfiguration>>updateFromRepositoriesWithoutCaching: (in category 'updating') ----- - updateFromRepositoriesWithoutCaching: packageIndex - - | oldNames newNames sortedNames newDeps dep | - dep := dependencies at: packageIndex. - oldNames := {dep versionInfo versionName}. - newNames := Dictionary new. - self repositories - do: [:repo | - ProgressNotification signal: '' extra: ('Checking {1}' translated format: {repo description}). - (repo possiblyNewerVersionsOfAnyOf: oldNames) - do: [:newName | newNames at: newName put: repo]] - displayingProgress: 'Searching new versions' translated. - - sortedNames := newNames keys asArray sort: - [:a :b | a versionNumber > b versionNumber]. - - newDeps := self dependencies copy. - newDeps at: packageIndex put: ( - sortedNames - detect: [:each | each packageAndBranchName = dep packageAndBranchName] - ifFound: [ :newName | - | repo | - repo := newNames at: newName. - (self versionInfoNamed: newName for: dep from: repo) - ifNil: [ dep ] - ifNotNil: [ :info | - MCVersionDependency package: dep package info: info ] ] - ifNone: [ dep ]). - - self dependencies: newDeps.! Item was removed: - ----- Method: MCConfiguration>>upgrade (in category 'actions') ----- - upgrade - ^self depsSatisfying: - [:dep | dep isFulfilledByAncestors not] - versionDo: - [:ver | - (self class upgradeIsMerge and: [ver shouldMerge]) - ifFalse: [ver load] - ifTrue: - [[ver merge] - on: MCNoChangesException - do: [:req| req resume ] - on: MCMergeResolutionRequest - do: [:request | - request merger conflicts isEmpty - ifTrue: [request resume: true] - ifFalse: [request pass]] - on: Deprecation - do: [:req| req resume ]]] - displayingProgress: 'upgrading packages' translated! Item was removed: - ----- 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! Item was removed: - ----- Method: MCConfiguration>>versionNamed:for:from: (in category 'private') ----- - versionNamed: aMCVersionName for: aDependency from: repo - - | baseName fileName ver | - (repo filterFileNames: repo cachedFileNames forVersionNamed: aMCVersionName) ifNotEmptyDo: [:cachedNames | - fileName := cachedNames anyOne. - self class extraProgressInfo - ifTrue: [ProgressNotification signal: '' extra: ('Using cached {1}' translated format: {fileName})]. - ver := repo versionNamed: fileName]. - ver ifNil: [ - baseName := self diffBaseFor: aDependency. - (baseName notNil and: [baseName ~= aMCVersionName and: [repo includesVersionNamed: baseName]]) ifTrue: [ - fileName := (MCDiffyVersion nameForVer: aMCVersionName base: baseName), '.mcd'. - self class extraProgressInfo - ifTrue: [ProgressNotification signal: '' extra: ('Downloading {1}' translated format: {fileName})]. - ver := [repo versionNamed: fileName] ifError: []]]. - ver ifNil: [ - fileName := aMCVersionName versionName, '.mcz'. - self class extraProgressInfo - ifTrue: [ProgressNotification signal: '' extra: ('Downloading {1}' translated format: {fileName})]. - ver := repo versionNamed: fileName]. - ^ver! Item was removed: - ----- Method: MCConfiguration>>withProgress:in:do: (in category 'private') ----- - withProgress: progressString in: aCollection do: aBlock - ^self class extraProgressInfo - ifTrue: [ aCollection do: aBlock displayingProgress: progressString ] - ifFalse: [ aCollection do: aBlock ] - - ! Item was removed: - ----- Method: MCConfiguration>>writerClass (in category 'accessing') ----- - writerClass - ^ MCMcmWriter ! Item was removed: - MCTool subclass: #MCConfigurationBrowser - instanceVariableNames: 'configuration dependencyIndex repositoryIndex activeEditWindow' - classVariableNames: '' - poolDictionaries: '' - category: 'MonticelloConfigurations'! - - !MCConfigurationBrowser commentStamp: 'dtl 5/10/2010 21:48' prior: 0! - A MCConfigurationBrowser displays an MCConfiguration, and edits the configuration to add or remove package dependencies and repository specifications. It allows a configuration to be stored in a repository or posted to an update stream.! Item was removed: - ----- Method: MCConfigurationBrowser class>>initialize (in category 'class initialization') ----- - initialize - TheWorldMenu registerOpenCommand: { 'Monticello Configurations' . { self . #open }. 'Monticello Configuration Browser' }.! Item was removed: - ----- Method: MCConfigurationBrowser class>>open (in category 'opening') ----- - open - ^self new show! Item was removed: - ----- Method: MCConfigurationBrowser>>activeEditWindow (in category 'morphic ui') ----- - activeEditWindow - ^activeEditWindow - ! Item was removed: - ----- Method: MCConfigurationBrowser>>activeEditWindow: (in category 'morphic ui') ----- - activeEditWindow: editWindow - "Set temporarily during the process of editing a version comment." - activeEditWindow ifNotNil: [:window | window delete]. - activeEditWindow := editWindow. - ! Item was removed: - ----- 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 {1} first!! - Skipping this package' translated format: {wc packageName})] - ifFalse: [ - self dependencies add: (MCVersionDependency - package: wc package - info: wc ancestors first)]]. - self changed: #dependencyList; changed: #description! Item was removed: - ----- Method: MCConfigurationBrowser>>addRepository (in category 'repositories') ----- - addRepository - (self pickRepositorySatisfying: - [ : ea | (self repositories includes: ea) not ]) ifNotNil: - [ : repo | repo class supportsConfigurations ifFalse: [ ^ self inform: 'Not all of these repositories support MCConfigurations.' translated ]. - self repositories add: repo. - self changed: #repositoryList ]! Item was removed: - ----- Method: MCConfigurationBrowser>>buttonSpecs (in category 'morphic ui') ----- - buttonSpecs - - ^ #( - ((button: ('Add' addDependency 'Add a dependency'))) - ((button: ('Update' updateMenu 'Update dependencies'))) - ((button: ('Install' installMenu 'Load/Merge/Upgrade into image'))) - ((button: ('Up' up 'Move item up in list' canMoveUp))) - ((button: ('Down' down 'Move item down in list' canMoveDown))) - ((button: ('Remove' remove 'Remove item' canRemove))) - ((button: ('Save' store 'Store the configuration to a repository'))) - ((button: ('Versions' versions 'Show prior versions of this configuration'))) - )! Item was removed: - ----- Method: MCConfigurationBrowser>>canMoveDown (in category 'testing') ----- - canMoveDown - ^self index between: 1 and: self maxIndex - 1 ! Item was removed: - ----- Method: MCConfigurationBrowser>>canMoveUp (in category 'testing') ----- - canMoveUp - ^self index > 1! Item was removed: - ----- Method: MCConfigurationBrowser>>canRemove (in category 'testing') ----- - canRemove - ^self index > 0! Item was removed: - ----- Method: MCConfigurationBrowser>>changedButtons (in category 'selection') ----- - changedButtons - self changed: #canMoveDown. - self changed: #canMoveUp. - self changed: #canRemove.! Item was removed: - ----- 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' translated! Item was removed: - ----- Method: MCConfigurationBrowser>>checkDependencies (in category 'dependencies') ----- - checkDependencies - ^self checkModified and: [self checkMissing]! Item was removed: - ----- Method: MCConfigurationBrowser>>checkMissing (in category 'dependencies') ----- - checkMissing - | missing | - missing := (self dependencies collect: - [ : ea | ea versionInfo name ]) asSet. - self repositories do: - [ : eachRepository | eachRepository cacheAllFileNamesDuring: - [ missing copy do: - [ : eachVersionName | (eachRepository includesVersionNamed: eachVersionName) ifTrue: [ missing remove: eachVersionName ] ] ] ]. - ^ missing isEmpty or: - [ self selectDependency: missing anyOne. - self confirm: - (String streamContents: - [ : strm | strm - nextPutAll: 'No repository found for' translated ; - cr. - missing do: - [ : r | strm - nextPutAll: r ; - cr ]. - strm nextPutAll: 'Do you still want to store?' translated ]) ]! Item was removed: - ----- 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:' translated; cr. - modified do: [:dep | strm nextPutAll: dep package name; cr]. - strm nextPutAll: 'Do you still want to store?' translated])]! Item was removed: - ----- Method: MCConfigurationBrowser>>checkRepositories (in category 'repositories') ----- - checkRepositories - | bad | - bad := self repositories reject: [:repo | repo class supportsConfigurations ]. - ^bad isEmpty or: [ - self selectRepository: bad first. - self inform: (String streamContents: [:strm | - strm nextPutAll: 'Please remove these repositories:' translated; cr. - bad do: [:r | strm nextPutAll: r description; cr]. - strm nextPutAll: '(only HTTP repositories are supported)' translated]). - false]. - ! Item was removed: - ----- 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' translated; cr. - bad do: [:r | strm nextPutAll: r description; cr]. - strm nextPutAll: 'Please fill in the details first!!' translated]). - false]. - ! Item was removed: - ----- Method: MCConfigurationBrowser>>completeStoreAction (in category 'actions') ----- - completeStoreAction - "The store method will arrange for this to be called after the user has entered - a comment for the configuration version being stored." - self activeEditWindow: nil. "Close the editor window" - self pickRepository - ifNotNil: [:repo | - configuration authorInitials: Utilities authorInitials. - configuration timeStamp: (DateAndTime fromSeconds: DateAndTime now asSeconds) printString. - configuration id: UUID new asString. - (repo includesVersionNamed: configuration name) - ifTrue: [self notify: ('The configuration does already exist in the repository you specified. If you proceed, it will be overwritten.\\Repository: {1}\Configuration: {2}\\Do you want to proceed anyway?' translated withCRs format: { repo description. configuration name })]. - repo storeVersion: configuration. - self inform: ('Saved {1}' translated format: {configuration name})]! Item was removed: - ----- Method: MCConfigurationBrowser>>configuration (in category 'accessing') ----- - configuration - ^configuration ifNil: [configuration := MCConfigurationExtended new]! Item was removed: - ----- Method: MCConfigurationBrowser>>configuration: (in category 'accessing') ----- - configuration: aConfiguration - configuration := aConfiguration! Item was removed: - ----- Method: MCConfigurationBrowser>>defaultExtent (in category 'morphic ui') ----- - defaultExtent - ^ 450 at 500! Item was removed: - ----- Method: MCConfigurationBrowser>>dependencies (in category 'accessing') ----- - dependencies - ^self configuration dependencies - ! Item was removed: - ----- Method: MCConfigurationBrowser>>dependencies: (in category 'accessing') ----- - dependencies: aCollection - self configuration dependencies: aCollection. - self changed: #dependencyList; changed: #description - ! Item was removed: - ----- Method: MCConfigurationBrowser>>dependencyIndex (in category 'selection') ----- - dependencyIndex - ^dependencyIndex ifNil: [0]! Item was removed: - ----- Method: MCConfigurationBrowser>>dependencyIndex: (in category 'selection') ----- - dependencyIndex: anInteger - dependencyIndex := anInteger. - dependencyIndex > 0 - ifTrue: [self repositoryIndex: 0]. - self changed: #dependencyIndex; changed: #description. - self changedButtons.! Item was removed: - ----- 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]]. - ])] - ! Item was removed: - ----- Method: MCConfigurationBrowser>>dependencyMenu: (in category 'morphic ui') ----- - dependencyMenu: aMenu - self fillMenu: aMenu fromSpecs: #(('add new dependency...' addDependency)). - self selectedDependency ifNotNil: [ - self fillMenu: aMenu fromSpecs: #( - addLine - ('remove this dependency' remove) - ('update this dependency from image' updateSelectedDependencyFromImage) - ('update this dependency from repositories' updateSelectedDependencyFromRepositories) - )]. - ^aMenu! Item was removed: - ----- Method: MCConfigurationBrowser>>description (in category 'description') ----- - description - self selectedDependency ifNotNil: - [:dep | - ^ ('Package: {1}\{2}' withCRs format: {dep package name. dep versionInfo summary}) asText]. - self selectedRepository ifNotNil: - [:repo | - ^repo creationTemplate - ifNotNil: [repo creationTemplate asText] - ifNil: [repo asCreationTemplate asText addAttribute: TextColor red]]. - ^'A configuration is a set of particular versions of packages. These can be used to manage multiple dependencies amongst packages when an update requires changes to multiple packages. One stores the current configuration and then modifies the various packages needing modification. On load, the image will be updated to at least the versions in the current configuration, hence providing the support needed to load the new packages.\\To create a new configuration first load the most up-to-date configuration in your repository (e.g., {1}), open that repository in the Monticello browser, scroll down to the "update" package, select the first entry in the list on the right hand side and click Browse, which will open the configuration in a new MCConfigurationBrowser. Then in the new MCConfigurationBrowser click Update, and choose "update all from image" from the pop-up menu. Click Store to save back to the repository. If required, one can add repositories to the browser to store the configuration in a different repository.' translated withCRs format: {MCHttpRepository trunkUrlString}! Item was removed: - ----- 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!!' translated - ] - ]. - - ! Item was removed: - ----- 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. - ]. - ! Item was removed: - ----- Method: MCConfigurationBrowser>>enterVersionCommentAndCompleteWith:nameForRestore: (in category 'morphic ui') ----- - enterVersionCommentAndCompleteWith: aConfigBrowser nameForRestore: originalName - "Open an editor for comment entry. When text is accepted from the editor, ask - if editing is done. If complete, then proceed to save the MCConfiguration. If cancelled, - close the edit window and do nothing further. Otherwise leave the edit window open - to allow further edits before proceeding to save the configuration." - | editWindow | - editWindow := Project uiManager - edit: configuration comment - label: ('Enter or edit a comment for {1}' translated format: {configuration name}) - accept: [:aText | | editingComplete | - editingComplete := UIManager default - confirm: 'Comment accepted' translated - title: ('Comment for {1}' translated format: {configuration name}) - trueChoice: 'Proceed to save configuration' translated - falseChoice: 'Continue editing comment' translated. - editingComplete - ifNil: [ "cancel button pressed" - configuration name: originalName. "cancelling, undo the changed name" - Project current - addDeferredUIMessage: [aConfigBrowser activeEditWindow ifNotNil: [ :win | win delete ]]] - ifNotNil: [ editingComplete - ifTrue: [configuration comment: aText asString. - Project current - addDeferredUIMessage: [aConfigBrowser completeStoreAction]] - ifFalse: [ "edit window remains open" ]]]. - aConfigBrowser activeEditWindow: editWindow.! Item was removed: - ----- Method: MCConfigurationBrowser>>includesPackage: (in category 'testing') ----- - includesPackage: aPackage - ^self dependencies anySatisfy: [:each | each package = aPackage]! Item was removed: - ----- Method: MCConfigurationBrowser>>index (in category 'selection') ----- - index - ^self dependencyIndex max: self repositoryIndex! Item was removed: - ----- 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' translated]! Item was removed: - ----- Method: MCConfigurationBrowser>>installMenu (in category 'actions') ----- - installMenu - | action | - action := UIManager default - chooseFrom: #('load packages' 'merge packages' 'upgrade packages') - values: #(#load #merge #upgrade). - action ifNotNil: [self perform: action].! Item was removed: - ----- Method: MCConfigurationBrowser>>list (in category 'selection') ----- - list - self dependencyIndex > 0 ifTrue: [^self dependencies]. - self repositoryIndex > 0 ifTrue: [^self repositories]. - ^#()! Item was removed: - ----- Method: MCConfigurationBrowser>>load (in category 'actions') ----- - load - self configuration load. - self changed: #dependencyList; changed: #description - ! Item was removed: - ----- Method: MCConfigurationBrowser>>maxIndex (in category 'selection') ----- - maxIndex - ^ self list size! Item was removed: - ----- Method: MCConfigurationBrowser>>merge (in category 'actions') ----- - merge - self configuration merge. - self changed: #dependencyList; changed: #description - ! Item was removed: - ----- Method: MCConfigurationBrowser>>pickName (in category 'morphic ui') ----- - pickName - | name | - name := Project uiManager - request: ('Name ({1} will be appended):' translated format: {'.' , self configuration writerClass extension}) - initialAnswer: self configuration suggestedNameOfNextVersion. - ^ name isEmpty ifFalse: [name]! Item was removed: - ----- Method: MCConfigurationBrowser>>pickRepository (in category 'morphic ui') ----- - pickRepository - ^self pickRepositorySatisfying: [:ea | true] - ! Item was removed: - ----- Method: MCConfigurationBrowser>>pickRepositorySatisfying: (in category 'morphic ui') ----- - pickRepositorySatisfying: aBlock - | index list | - list := MCRepositoryGroup default repositories select: aBlock. - index := Project uiManager chooseFrom: (list collect: [:ea | ea description]) - title: 'Repository:' translated. - ^ index = 0 ifFalse: [list at: index]! Item was removed: - ----- Method: MCConfigurationBrowser>>pickWorkingCopiesSatisfying: (in category 'morphic ui') ----- - pickWorkingCopiesSatisfying: aBlock - | copies item | - copies := (MCWorkingCopy allManagers select: aBlock) - sort: [:a :b | a packageName <= b packageName]. - item := Project uiManager chooseFrom: #('match ...'),(copies collect: [:ea | ea packageName]) lines: #(1) title: 'Package:' translated. - item = 1 ifTrue: [ - | pattern | - pattern := Project uiManager request: 'Packages matching:' translated 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}]! Item was removed: - ----- Method: MCConfigurationBrowser>>remove (in category 'actions') ----- - remove - self canRemove ifTrue: [ - self list removeAt: self index. - self changedList. - self updateIndex. - ]. - ! Item was removed: - ----- Method: MCConfigurationBrowser>>removeRepository (in category 'repositories') ----- - removeRepository - repositoryIndex > 0 - ifTrue: [self repositories removeAt: repositoryIndex. - repositoryIndex := 0. - self changed: #repositoryList]! Item was removed: - ----- Method: MCConfigurationBrowser>>repositories (in category 'accessing') ----- - repositories - ^ self configuration repositories! Item was removed: - ----- Method: MCConfigurationBrowser>>repositories: (in category 'accessing') ----- - repositories: aCollection - ^self configuration repositories: aCollection - ! Item was removed: - ----- Method: MCConfigurationBrowser>>repositoryIndex (in category 'selection') ----- - repositoryIndex - ^repositoryIndex ifNil: [0]! Item was removed: - ----- Method: MCConfigurationBrowser>>repositoryIndex: (in category 'selection') ----- - repositoryIndex: anInteger - repositoryIndex := anInteger. - repositoryIndex > 0 - ifTrue: [self dependencyIndex: 0]. - self changed: #repositoryIndex; changed: #description. - self changedButtons.! Item was removed: - ----- Method: MCConfigurationBrowser>>repositoryList (in category 'repositories') ----- - repositoryList - ^self repositories collect: [:ea | ea description] - ! Item was removed: - ----- Method: MCConfigurationBrowser>>repositoryListHeight (in category 'morphic ui') ----- - repositoryListHeight - - ^ ToolBuilder default listHeightFor: 3 "items"! Item was removed: - ----- Method: MCConfigurationBrowser>>repositoryListHeightNegated (in category 'morphic ui') ----- - repositoryListHeightNegated - - ^ self repositoryListHeight negated! Item was removed: - ----- Method: MCConfigurationBrowser>>repositoryMenu: (in category 'morphic ui') ----- - repositoryMenu: aMenu - self fillMenu: aMenu fromSpecs: #(('add repository...' addRepository)). - self selectedRepository ifNotNil: [ - self fillMenu: aMenu fromSpecs: #(('remove repository' removeRepository))]. - ^aMenu - ! Item was removed: - ----- Method: MCConfigurationBrowser>>selectDependency: (in category 'selection') ----- - selectDependency: aDependency - self dependencyIndex: (self dependencies indexOf: aDependency)! Item was removed: - ----- Method: MCConfigurationBrowser>>selectRepository: (in category 'selection') ----- - selectRepository: aRepository - self repositoryIndex: (self repositories indexOf: aRepository)! Item was removed: - ----- Method: MCConfigurationBrowser>>selectedDependency (in category 'dependencies') ----- - selectedDependency - ^ self dependencies at: self dependencyIndex ifAbsent: []! Item was removed: - ----- Method: MCConfigurationBrowser>>selectedPackage (in category 'dependencies') ----- - selectedPackage - ^ self selectedDependency ifNotNil: [:dep | dep package]! Item was removed: - ----- Method: MCConfigurationBrowser>>selectedRepository (in category 'repositories') ----- - selectedRepository - ^ self repositories at: self repositoryIndex ifAbsent: []! Item was removed: - ----- Method: MCConfigurationBrowser>>store (in category 'actions') ----- - store - self activeEditWindow: nil. "Close previous if still open" - (self checkRepositories and: [self checkDependencies]) ifFalse: [^self]. - self pickName ifNotNil: [:name | | originalName | - originalName := configuration name. - configuration name: name. - self enterVersionCommentAndCompleteWith: self nameForRestore: originalName ].! Item was removed: - ----- 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. - ].! Item was removed: - ----- Method: MCConfigurationBrowser>>updateFromImage (in category 'updating') ----- - updateFromImage - self configuration updateFromImage. - self changed: #dependencyList; changed: #description - ! Item was removed: - ----- Method: MCConfigurationBrowser>>updateFromRepositories (in category 'updating') ----- - updateFromRepositories - self configuration updateFromRepositories. - self changed: #dependencyList; changed: #description - ! Item was removed: - ----- Method: MCConfigurationBrowser>>updateIndex (in category 'selection') ----- - updateIndex - self index > 0 ifTrue: [self index: (self index min: self maxIndex)]! Item was removed: - ----- Method: MCConfigurationBrowser>>updateMenu (in category 'actions') ----- - updateMenu - | action | - action := Project uiManager - chooseOptionFrom: #('update all from image' 'update all from repositories') - values: #(#updateFromImage #updateFromRepositories). - action ifNotNil: [self perform: action].! Item was removed: - ----- Method: MCConfigurationBrowser>>updateSelectedDependencyFromImage (in category 'actions') ----- - updateSelectedDependencyFromImage - self configuration updateFromImage: self dependencyIndex. - self changed: #dependencyList; changed: #description - ! Item was removed: - ----- Method: MCConfigurationBrowser>>updateSelectedDependencyFromRepositories (in category 'actions') ----- - updateSelectedDependencyFromRepositories - self configuration updateFromRepositories: self dependencyIndex. - self changed: #dependencyList; changed: #description - ! Item was removed: - ----- Method: MCConfigurationBrowser>>upgrade (in category 'actions') ----- - upgrade - self configuration upgrade. - self changed: #dependencyList; changed: #description - ! Item was removed: - ----- Method: MCConfigurationBrowser>>versions (in category 'actions') ----- - versions - configuration priorVersions explore! Item was removed: - ----- Method: MCConfigurationBrowser>>widgetSpecs (in category 'morphic ui') ----- - widgetSpecs - ^ #( - ((buttonRow) (0 0 1 0) (0 0 0 defaultButtonPaneHeight)) - ((listMorph:selection:menu: dependencyList dependencyIndex dependencyMenu:) (0 0 1 0.8) (0 defaultButtonPaneHeight 0 repositoryListHeightNegated)) - ((listMorph:selection:menu: repositoryList repositoryIndex repositoryMenu:) (0 0.8 1 0.8) (0 repositoryListHeightNegated 0 0)) - ((textMorph: description) (0 0.8 1 1) (0 0 0 0)) - )! Item was removed: - MCConfiguration subclass: #MCConfigurationExtended - instanceVariableNames: 'mcmVersion id authorInitials timeStamp comment priorVersions' - classVariableNames: 'HistoryLimit' - poolDictionaries: '' - category: 'MonticelloConfigurations'! - - !MCConfigurationExtended commentStamp: 'dtl 4/13/2020 13:57' prior: 0! - A MCConfigurationExtended is a configuration with author initials, timestamp, comment, and a list of prior versions. Its external storage format is organized for compatibility with MCConfiguration, such that an image wtih support for only MCConfiguration can use configurations saved from a MCConfigurationExtended. The intended use is to enable documentation of configuration maps, and to allow modifications to a configuration map without loss of version history.! Item was removed: - ----- Method: MCConfigurationExtended class>>initialize (in category 'class initialization') ----- - initialize - - "Limit the number of prior versions in the history list to prevent MCM files from - becoming unnecessarily large over time. Versions are idenitified by a UUID - identifier, which should be sufficient for building a full version history if needed." - HistoryLimit := 10.! Item was removed: - ----- Method: MCConfigurationExtended>>= (in category 'comparing') ----- - = configuration - ^ (((super = configuration - and: [configuration authorInitials = authorInitials]) - and: [configuration timeStamp = timeStamp]) - and: [configuration id = id]) - and: [configuration comment = comment]. - ! Item was removed: - ----- Method: MCConfigurationExtended>>addPriorVersion: (in category 'initialize') ----- - addPriorVersion: mcConfig - priorVersions add: mcConfig! Item was removed: - ----- Method: MCConfigurationExtended>>authorInitials (in category 'accessing') ----- - authorInitials - ^ authorInitials - ! Item was removed: - ----- Method: MCConfigurationExtended>>authorInitials: (in category 'accessing') ----- - authorInitials: initials - authorInitials := initials - ! Item was removed: - ----- Method: MCConfigurationExtended>>comment (in category 'accessing') ----- - comment - ^ comment - ! Item was removed: - ----- Method: MCConfigurationExtended>>comment: (in category 'accessing') ----- - comment: aString - comment := aString - ! Item was removed: - ----- Method: MCConfigurationExtended>>contentsOn:keyPrefix: (in category 'printing') ----- - contentsOn: aStream keyPrefix: prefix - - super contentsOn: aStream keyPrefix: prefix. - - mcmVersion ifNotNil: [:ver | - aStream cr. - aStream nextPutAll: prefix,'mcmVersion '. - aStream print: ver]. - - id ifNotNil: [:uuid | - aStream cr. - aStream nextPutAll: prefix,'id '. - aStream print: uuid]. - - authorInitials ifNotNil: [:initials | - aStream cr. - aStream nextPutAll: prefix,'authorInitials '. - aStream print: initials]. - - timeStamp ifNotNil: [:ts | - aStream cr. - aStream nextPutAll: prefix,'timeStamp '. - aStream print: ts]. - - comment ifNotNil: [:c | - aStream cr. - aStream nextPutAll: prefix,'comment '. - aStream print: c]. - - "Keys in the prior versions have a prefix to prevent them being parsed - into a MCConfiguration when an image that does not contain support for the - newer MCConfigurationExtended format. This allows older images to read - an MCM file with extended format and version history, treating it as if it - were data for the original MCConfiguration. See #copyWithoutKeyPrefix: - for removal of the prefix during parsing." - priorVersions do: [:e | e copyWithoutHistory contentsOn: aStream keyPrefix: 'X']. - ! Item was removed: - ----- Method: MCConfigurationExtended>>copyForEdit (in category 'copying') ----- - copyForEdit - "Preparing to edit a configuration. Answer a new copy with the original - instance saved in version history, and with no author initials or timestamp. - The initials and timestamp are to be set immediately prior to saving an edited - version." - | config | - config := super copyForEdit. - config priorVersions: priorVersions copy. - config priorVersions addFirst: self. - config authorInitials: nil. - config timeStamp: nil. - config comment: self comment copy. - config trimVersionList. - ^ config! Item was removed: - ----- Method: MCConfigurationExtended>>copyWithoutHistory (in category 'copying') ----- - copyWithoutHistory - "When a configuration is part of a version history, do not repeatedly - export its history." - - | config | - config := self copy. - config priorVersions: OrderedCollection new. - ^ config! Item was removed: - ----- Method: MCConfigurationExtended>>hash (in category 'comparing') ----- - hash - ^ (super hash bitOr: timeStamp hash) bitXor: id. - ! Item was removed: - ----- Method: MCConfigurationExtended>>id (in category 'accessing') ----- - id - ^ id! Item was removed: - ----- Method: MCConfigurationExtended>>id: (in category 'accessing') ----- - id: uuid - id := uuid! Item was removed: - ----- Method: MCConfigurationExtended>>initialize (in category 'initialize') ----- - initialize - super initialize. - mcmVersion := '2'. - priorVersions := OrderedCollection new.! Item was removed: - ----- Method: MCConfigurationExtended>>initializeFromKey:value: (in category 'initialize') ----- - initializeFromKey: key value: value - super initializeFromKey: key value: value. - key = #mcmVersion - ifTrue: [mcmVersion := value]. - key = #id - ifTrue: [id := value]. - key = #authorInitials - ifTrue: [authorInitials := value]. - key = #timeStamp - ifTrue: [timeStamp := value]. - key = #comment - ifTrue: [comment := value]. - - ! Item was removed: - ----- Method: MCConfigurationExtended>>mcmVersion (in category 'accessing') ----- - mcmVersion - ^ mcmVersion - ! Item was removed: - ----- Method: MCConfigurationExtended>>printOn: (in category 'printing') ----- - printOn: aStream - super printOn: aStream. - aStream nextPutAll: ' ', name asString, ' ', timeStamp asString, ' (', id asString, ')'.! Item was removed: - ----- Method: MCConfigurationExtended>>priorVersions (in category 'accessing') ----- - priorVersions - ^ priorVersions - ! Item was removed: - ----- Method: MCConfigurationExtended>>priorVersions: (in category 'accessing') ----- - priorVersions: collection - priorVersions := collection - ! Item was removed: - ----- Method: MCConfigurationExtended>>timeStamp (in category 'accessing') ----- - timeStamp - ^ timeStamp - ! Item was removed: - ----- Method: MCConfigurationExtended>>timeStamp: (in category 'accessing') ----- - timeStamp: aString - timeStamp := aString - ! Item was removed: - ----- Method: MCConfigurationExtended>>trimVersionList (in category 'initialize') ----- - trimVersionList - [priorVersions size > HistoryLimit] - whileTrue: [priorVersions removeLast]. - ! Item was removed: - ----- Method: MCConfigurationExtended>>versions (in category 'initialize') ----- - versions - "myself with all prior versions" - ^ { self } , priorVersions. - ! Item was removed: - ----- Method: MCFileBasedRepository class>>supportsConfigurations (in category '*monticelloconfigurations') ----- - supportsConfigurations - ^ true! Item was removed: - MCVersionReader subclass: #MCMcmReader - instanceVariableNames: 'fileName configuration' - classVariableNames: '' - poolDictionaries: '' - category: 'MonticelloConfigurations'! - - !MCMcmReader commentStamp: 'dtl 5/10/2010 22:22' prior: 0! - A MCMcmReader creates an MCConfiguration by reading an array specification from a stream. - - ! Item was removed: - ----- Method: MCMcmReader class>>extension (in category 'accessing') ----- - extension - ^ 'mcm'! Item was removed: - ----- Method: MCMcmReader class>>loadVersionFile: (in category 'instance creation') ----- - loadVersionFile: fileName - | version | - version := self versionFromFile: fileName. - version load. - ! Item was removed: - ----- Method: MCMcmReader class>>on:fileName: (in category 'instance creation') ----- - on: aStream fileName: aFileName - | reader | - reader := self on: aStream. - reader fileName: aFileName. - ^reader! Item was removed: - ----- Method: MCMcmReader>>configuration (in category 'accessing') ----- - configuration - configuration ifNil: [self loadConfiguration]. - "browser modifies configuration, but the reader might get cached" - ^configuration copy! Item was removed: - ----- Method: MCMcmReader>>fileName: (in category 'accessing') ----- - fileName: aString - fileName := aString! Item was removed: - ----- Method: MCMcmReader>>loadConfiguration (in category 'accessing') ----- - loadConfiguration - stream reset. - configuration := MCConfiguration fromArray: (MCScanner scan: stream). - configuration name ifNil: [ configuration name: self parseNameFromFilename ]! Item was removed: - ----- Method: MCMcmReader>>loadVersionInfo (in category 'accessing') ----- - loadVersionInfo - info := self configuration! Item was removed: - ----- Method: MCMcmReader>>parseNameFromFilename (in category 'accessing') ----- - parseNameFromFilename - ^fileName ifNotNil: [(fileName findTokens: '/\:') last copyUpToLast: $.]! Item was removed: - ----- Method: MCMcmReader>>version (in category 'accessing') ----- - version - ^self configuration! Item was removed: - Object subclass: #MCMcmUpdater - instanceVariableNames: 'repository updateMapName lastUpdateMap' - classVariableNames: 'DefaultUpdateMap DefaultUpdateURL Registry SkipPackages UpdateFromServerAtStartup UpdateMissingPackages' - poolDictionaries: '' - category: 'MonticelloConfigurations'! - - !MCMcmUpdater commentStamp: 'dtl 10/12/2015 19:45' prior: 0! - MCMcmUpdater provides utility methods for updating Monticello packages from Monticello configurations. - - When Monticello configurations are stored in a repository (or repositories), MCMcmUpdater acts as an update stream. It first ensures that each configuration map has been loaded in sequence, then updates the last configuration map to the most recent version for each specified package, and finally loads these versions to produce a fully updated configuration. - - Currently if a set of packages are unloaded from the image, using this class to reload them may cause problems, depending on what dependencies those classes have. Success is not assured. Removing packages via SmalltalkImage>>unloadAllKnownPackages will be successful, it flags the packages removed so that they are not loaded by this utility. - - If you wish to not have MCMcmUpdater update packages, there are two ways to handle this: - - 1) To have MCMcmUpdater not update any packages not currently in the image set the UpdateMissingPackages preference to false: - MCMcmUpdater updateMissingPackages: false - Note that any new packages added to the repositories will not be picked up when this is turned off. - 2) To have MCMcmUpdater not update a specific package, evaluate - MCMcmUpdater disableUpdatesOfPackage: <packageName> - - Class Variables definitions: - - DefaultUpdateURL - String: the URL that will be checked by default for updates. This would be set for a common standard location to check. - - Repository - A registry of known MCMcmUpdater instances identified by repository URL and update map name. - - SkipPackages - Set of Strings: names of packages to not update in MCMcmUpdater (empty by default). - - UpdateMissingPackages - Boolean: if true (default), new packages in the update config map will be loaded unless they are in SkipPackages. If false, packages not currently loaded in the image will not be loaded by MCMcmUpdater. (This can be dangerous if packages are split - use at your own risk). - - Instance Variables: - - updateMapName - Base name of the files used for this updater, typically a name such as 'update' or 'update.spur'. - - repository - URL of the repository in which the update maps are located. - - lastUpdateMap - Dictionary of Integer: version number of the last loaded update map per repository. Keeps track of the last configuration map, so that the utility will not have to run through the full history in the repositories each time you ask to update. - ! Item was removed: - ----- Method: MCMcmUpdater class>>clearRegistry (in category 'class initialization') ----- - clearRegistry - "Save the current default updater, clear the registry, and re-register the current updater. - This is intended for cleaning up an image prior to public release. Assumes that the - current updater is the one intended for ongoing use in this image." - - "MCMcmUpdater clearRegistry" - - | current | - current := self default. - Registry := nil. - current register. - ^Registry! Item was removed: - ----- Method: MCMcmUpdater class>>default (in category 'instance creation') ----- - default - "The default instance for system updates. Uses a default repository and update map - name that may be set as preferences." - - ^self updateMapNamed: self updateMapName repository: self defaultUpdateURL - ! Item was removed: - ----- Method: MCMcmUpdater class>>defaultBaseName (in category 'updating') ----- - defaultBaseName - "If not otherwise specified, look for update maps with this base name" - - ^ 'update'! Item was removed: - ----- Method: MCMcmUpdater class>>defaultUpdateURL (in category 'preferences') ----- - defaultUpdateURL - "The default update repository URL" - - <preference: 'Update URL' - category: 'updates' - description: 'The repository URL for loading updates' - type: #String> - - ^ DefaultUpdateURL ifNil: [ - self notify: 'There is no update URL configured. Proceed to use Squeak''s Trunk repository.' translated. - MCHttpRepository trunkUrlString]! Item was removed: - ----- Method: MCMcmUpdater class>>defaultUpdateURL: (in category 'preferences') ----- - defaultUpdateURL: aStringOrNil - "The default update repository URL. Avoid clearing this preference via 'nil'. See ReleaseBuilder class >> #switchToNewRepository:." - - aStringOrNil ifNotNil: [DefaultUpdateURL := aStringOrNil].! Item was removed: - ----- Method: MCMcmUpdater class>>disableUpdatesOfPackage: (in category 'preferences') ----- - disableUpdatesOfPackage: packageName - self skipPackages add: packageName! Item was removed: - ----- Method: MCMcmUpdater class>>enableUpdatesForAllPackages (in category 'preferences') ----- - enableUpdatesForAllPackages - SkipPackages := Set new! Item was removed: - ----- Method: MCMcmUpdater class>>enableUpdatesOfPackage: (in category 'preferences') ----- - enableUpdatesOfPackage: packageName - self skipPackages remove: packageName ifAbsent: [].! Item was removed: - ----- Method: MCMcmUpdater class>>forRepository:updateMap: (in category 'registry') ----- - forRepository: repository updateMap: basename - "Answer the requested updater from the repository, or nil of not found" - - "MCMcmUpdater forRepository: 'http://source.squeak.org/trunk' updateMap: 'update'" - "MCMcmUpdater forRepository: 'foo' updateMap: 'bar'" - - ^ ((Registry ifNil: [Registry := Dictionary new]) - at: repository - ifAbsent: [^nil]) - at: basename - ifAbsent: [^nil]! Item was removed: - ----- Method: MCMcmUpdater class>>initialize (in category 'class initialization') ----- - initialize - "MCMcmUpdater initialize" - - DefaultUpdateURL ifNil:[ - DefaultUpdateURL := MCHttpRepository trunkUrlString. - DefaultUpdateMap := self defaultBaseName. - ]. - ! Item was removed: - ----- Method: MCMcmUpdater class>>registry (in category 'registry') ----- - registry - "Private - unit test support" - ^Registry! Item was removed: - ----- Method: MCMcmUpdater class>>registry: (in category 'registry') ----- - registry: registry - "Private - unit test support" - Registry := registry! Item was removed: - ----- Method: MCMcmUpdater class>>repository:updateMap: (in category 'instance creation') ----- - repository: urlOrDirectoryPath updateMap: baseName - "Answer a new instance with empty last update map, not yet registered" - - ^ self repository: urlOrDirectoryPath updateMap: baseName lastUpdateMap: Dictionary new! Item was removed: - ----- Method: MCMcmUpdater class>>repository:updateMap:lastUpdateMap: (in category 'instance creation') ----- - repository: urlOrDirectoryPath updateMap: baseName lastUpdateMap: dictionary - "Answer a new instance, not yet registered" - - ^ self new - repository: urlOrDirectoryPath; - updateMapName: baseName; - lastUpdateMap: dictionary! Item was removed: - ----- Method: MCMcmUpdater class>>skipPackages (in category 'preferences') ----- - skipPackages - ^SkipPackages ifNil: [SkipPackages := Set new]! Item was removed: - ----- Method: MCMcmUpdater class>>updateFromRepository: (in category 'updating') ----- - updateFromRepository: updaterUrlKey - "Update using an MCMcmUpdater identified by updaterUrlKey using the default - update map baseName" - - "MCMcmUpdater updateFromRepository: 'http://squeaksource.com/MCUpdateTest' " - - ^ self updateFromRepository: updaterUrlKey baseName: self defaultBaseName - ! Item was removed: - ----- Method: MCMcmUpdater class>>updateFromRepository:baseName: (in category 'updating') ----- - updateFromRepository: updaterUrlKey baseName: baseName - "Update using an MCMcmUpdater identified by updaterUrlKey, and using - update map baseName" - - "MCMcmUpdater - updateFromRepository: 'http://squeaksource.com/MCUpdateTest' - baseName: 'update' " - - ^ self updateFromRepository: updaterUrlKey baseName: baseName interactive: true! Item was removed: - ----- Method: MCMcmUpdater class>>updateFromRepository:baseName:interactive: (in category 'updating') ----- - updateFromRepository: updaterUrlKey baseName: baseName interactive: interactive - "Update using an MCMcmUpdater identified by updaterUrlKey, and using - update map baseName" - - "MCMcmUpdater - updateFromRepository: 'http://squeaksource.com/MCUpdateTest' - baseName: 'update' - interactive: false " - - ^ (self updateMapNamed: baseName repository: updaterUrlKey) - doUpdate: interactive! Item was removed: - ----- Method: MCMcmUpdater class>>updateFromServer (in category 'updating') ----- - updateFromServer - "Update the image by loading all pending updates from the server." - - ^self default doUpdate: true - ! Item was removed: - ----- Method: MCMcmUpdater class>>updateFromServerAtStartup (in category 'preferences') ----- - updateFromServerAtStartup - <preference: 'Update from server at startup' - category: 'updates' - description: 'If true, the system will check for and load any available updates.' - type: #Boolean> - ^ UpdateFromServerAtStartup ifNil: [false].! Item was removed: - ----- Method: MCMcmUpdater class>>updateFromServerAtStartup: (in category 'preferences') ----- - updateFromServerAtStartup: aBool - "Whether to update the image on startup." - - UpdateFromServerAtStartup := aBool.! Item was removed: - ----- Method: MCMcmUpdater class>>updateMapName (in category 'preferences') ----- - updateMapName - "The default update map name" - - <preference: 'Update map name' - category: 'updates' - description: 'Base name for the update maps' - type: #String> - - ^DefaultUpdateMap ifNil: ['update']! Item was removed: - ----- Method: MCMcmUpdater class>>updateMapName: (in category 'preferences') ----- - updateMapName: mapName - "The default update map name for the default updater." - - DefaultUpdateMap := mapName! Item was removed: - ----- Method: MCMcmUpdater class>>updateMapNamed:repository: (in category 'instance creation') ----- - updateMapNamed: baseName repository: urlOrDirectoryPath - "Answer an instance for the given repository URL with a base update name baseName, - Register a new instance if not present in the registry." - - " | updater1 updater2 | - updater1 := self updateMapNamed: 'BAR' repository: 'FOO'. - updater2 := self updateMapNamed: 'BAZ' repository: 'FOO'. - updater1 unregister. - updater2 unregister. - Registry" - - ^(self forRepository: urlOrDirectoryPath updateMap: baseName) - ifNil: [ "register a new updater" - (self repository: urlOrDirectoryPath updateMap: baseName) register]. - - ! Item was removed: - ----- Method: MCMcmUpdater class>>updateMissingPackages (in category 'preferences') ----- - updateMissingPackages - "Whether to update missing (unloaded) packages" - - <preference: 'Update missing package' - category: 'updates' - description: 'If true, missing (unloaded) packages will be loaded during the update process.' - type: #Boolean> - - ^UpdateMissingPackages ifNil:[true]! Item was removed: - ----- Method: MCMcmUpdater class>>updateMissingPackages: (in category 'preferences') ----- - updateMissingPackages: aBool - "Whether to update missing (unloaded) packages" - - UpdateMissingPackages := aBool.! Item was removed: - ----- Method: MCMcmUpdater>>dependentPackages (in category 'private') ----- - dependentPackages - "Answers all packages that are referenced in the update map." - - | repo updateList | - repo := self getRepositoryFromRepositoryGroup. - updateList := self refreshUpdateMapFor: repo with: (self updateListFor: repo). - ^ updateList gather: [:assoc | - (repo versionNamed: assoc value) dependencies - collect: [:dep | dep package]] - ! Item was removed: - ----- Method: MCMcmUpdater>>doUpdate: (in category 'updating') ----- - doUpdate: interactive - "Update the image by loading all pending updates from the server. If this is - the default updater for the system, update the system version when complete. - If interteractive use a modal notifier, otherwise only update the transcript. - Flush all caches. If a previous download failed this is often helpful" - - | previousUpdateLevel ensureTranscriptSetting | - previousUpdateLevel := SystemVersion current highestUpdate. - MCFileBasedRepository flushAllCaches. - ensureTranscriptSetting := MCConfiguration ensureOpenTranscript. - [MCConfiguration ensureOpenTranscript: interactive. - self updateFromRepository - ifNil: - [interactive ifTrue: [ ^self inform: 'Unable to retrieve updates from remote repository.' translated ]. - Transcript cr; show: '========== Unable to retrieve updates from remote repository. ==========' translated; cr. - ^ self ] - ifNotNil: [:config| self logUpdateOf: config previousUpdateLevel: previousUpdateLevel interactive: interactive]] - ensure: - [MCConfiguration ensureOpenTranscript: ensureTranscriptSetting]! Item was removed: - ----- Method: MCMcmUpdater>>doUpdate:upTo: (in category 'updating') ----- - doUpdate: interactive upTo: versionNumber - "Update the image by loading all pending updates from the server. If this is - the default updater for the system, update the system version when complete. - If interteractive use a modal notifier, otherwise only update the transcript. - Flush all caches. If a previous download failed this is often helpful" - - | config previousUpdateLevel | - previousUpdateLevel := SystemVersion current highestUpdate. - MCFileBasedRepository flushAllCaches. - config := self updateFromRepositories: { self repository } upTo: versionNumber. - config ifNil: [ - interactive ifTrue: [ ^self inform: 'Unable to retrieve updates from remote repository.' translated ]. - Transcript cr; show: '========== Unable to retrieve updates from remote repository. ==========' translated; cr. - ^ self ]. - self logUpdateOf: config previousUpdateLevel: previousUpdateLevel interactive: interactive - ! Item was removed: - ----- Method: MCMcmUpdater>>doUpdateUpTo: (in category 'updating') ----- - doUpdateUpTo: versionNumber - "Update the image by loading all pending updates from the server. If this is - the default updater for the system, update the system version when complete. - Flush all caches. If a previous download failed this is often helpful" - - ^self doUpdate: true upTo: versionNumber - ! Item was removed: - ----- Method: MCMcmUpdater>>getRepositoryFromRepositoryGroup (in category 'private') ----- - getRepositoryFromRepositoryGroup - "Answer the repository for this updater, ensuring that it is registered in the default MCRepositoryGroup" - - ^ MCRepositoryGroup default repositories - detect: [:r | r description = repository] - ifNone: [| r | - r := self repositoryAt: repository. - MCRepositoryGroup default addRepository: r. - r] - ! Item was removed: - ----- Method: MCMcmUpdater>>isRegistered (in category 'registry') ----- - isRegistered - "True if this instance is registered. False if another instance with the same - repository and updateNameName is registered." - - ^self == ((Registry - at: repository - ifAbsent: [^false]) - at: updateMapName - ifAbsent: [^false]). - - ! Item was removed: - ----- Method: MCMcmUpdater>>lastUpdateMap (in category 'accessing') ----- - lastUpdateMap - - ^ lastUpdateMap ifNil: [ lastUpdateMap := Dictionary new ] - ! Item was removed: - ----- Method: MCMcmUpdater>>lastUpdateMap: (in category 'accessing') ----- - lastUpdateMap: aDictionary - - lastUpdateMap := aDictionary - ! Item was removed: - ----- Method: MCMcmUpdater>>logUpdateOf:previousUpdateLevel:interactive: (in category 'updating') ----- - logUpdateOf: config previousUpdateLevel: previousUpdateLevel interactive: interactive - MCMcmUpdater default == self - ifTrue: [ - config setSystemVersion. - interactive ifTrue: [ - self inform: (self updateMessageFor: previousUpdateLevel)]. - Transcript cr; - show: ('========== Update of {1} completed: ' translated format: {self repositoryName}); - show: previousUpdateLevel; - show: ' -> ' ; - show: SystemVersion current highestUpdate; - show: ' =========='; cr ] - ifFalse: [ - interactive - ifTrue: [ self inform: ('Update of {1} completed.' translated format: {self repositoryName}) ]. - Transcript cr; show: ('========== Update of {1} completed. ==========' translated format: {self repositoryName}); cr ] - - ! Item was removed: - ----- Method: MCMcmUpdater>>printOn: (in category 'printing') ----- - printOn: aStream - - super printOn: aStream. - aStream nextPutAll: ' on '''; - nextPutAll: updateMapName asString; - nextPutAll: ''' at '; - nextPutAll: repository asString! Item was removed: - ----- Method: MCMcmUpdater>>refreshUpdateMapFor:with: (in category 'updating') ----- - refreshUpdateMapFor: r with: updateList - "Update the lastUpdateMap and answer a possibly reduced updateList" - - | config | - (lastUpdateMap at: r description ifAbsent: [0]) = 0 ifTrue: [ - "No update has ever been loaded from this repo. If no package is - present in the image either, we can skip right to the latest config" - config := r versionNamed: updateList last value. - (config dependencies anySatisfy: [:dep | dep package hasWorkingCopy]) - ifFalse: [(self useLatestPackagesFrom: r) - ifTrue: [lastUpdateMap at: r description put: updateList last key]. - updateList isEmpty - ifTrue: [^ #()] - ifFalse: [^ updateList last: 1]]]. - ^ updateList - ! Item was removed: - ----- Method: MCMcmUpdater>>register (in category 'registry') ----- - register - "Register this instance, keyed by repository and update map name. Each update - maintains its own lastUpdateMap. The registry permits multilple updaters to be - maintained, with each updater keeping track of its own last update map." - - repository ifNil: [self error: 'repository is ', repository asString]. - updateMapName ifNil: [self error: 'updateMapName is ', updateMapName asString]. - updateMapName isEmpty ifTrue: [self error: 'updateMapName must be specified']. - ((Registry ifNil: [Registry := Dictionary new]) - at: repository - ifAbsentPut: [Dictionary new]) - at: updateMapName put: self - - ! Item was removed: - ----- Method: MCMcmUpdater>>repository (in category 'accessing') ----- - repository - "URL string of the repository for the update maps" - - ^ repository! Item was removed: - ----- Method: MCMcmUpdater>>repository: (in category 'accessing') ----- - repository: urlOrDirectoryPath - - repository := urlOrDirectoryPath! Item was removed: - ----- Method: MCMcmUpdater>>repositoryAt: (in category 'private') ----- - repositoryAt: urlOrDirectoryPath - "Answer a repository, assuming that urlOrDirectoryPath represents - either an HTTP repository or a local directory repository. The common - case is an HTTP repository, but a local repository may be useful for - testing an update stream prior to posting the update maps to a public - location." - - (FileDirectory default directoryExists: urlOrDirectoryPath) - ifTrue: [^ MCDirectoryRepository path: urlOrDirectoryPath] - ifFalse: [^ MCHttpRepository - location: repository - user: '' - password: ''] - ! Item was removed: - ----- Method: MCMcmUpdater>>repositoryName (in category 'private') ----- - repositoryName - ^repository allButFirst: (repository lastIndexOf: $/ ifAbsent: [0])! Item was removed: - ----- Method: MCMcmUpdater>>skipPackages (in category 'private') ----- - skipPackages - ^SkipPackages ifNil: [SkipPackages := Set new]! Item was removed: - ----- Method: MCMcmUpdater>>unregister (in category 'registry') ----- - unregister - "If this instance is registered, remove it frorm the registry." - - self isRegistered - ifTrue: [(Registry at: repository) removeKey: updateMapName. - (Registry at: repository) isEmpty - ifTrue: [Registry removeKey: repository]] - ! Item was removed: - ----- Method: MCMcmUpdater>>updateFromConfig: (in category 'updating') ----- - updateFromConfig: config - - "Skip packages that were specifically unloaded" - config dependencies: (config dependencies - reject: [:dep| self class skipPackages includes: dep package name]). - self class updateMissingPackages ifFalse:[ - "Skip packages that are not in the image" - config dependencies: (config dependencies - select: [:dep| dep package hasWorkingCopy])]. - (config dependencies allSatisfy:[:dep| dep isFulfilled]) - ifFalse:[config upgrade]. - ! Item was removed: - ----- Method: MCMcmUpdater>>updateFromRepositories:upTo: (in category 'updating') ----- - updateFromRepositories: repositoryUrls upTo: versionNumber - "MCMcmUpdater updateFromRepositories: #( - 'http://squeaksource.com/MCUpdateTest' - )" - - | repos config | - MCConfiguration upgradeIsMerge: true. - "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 | config := self updateFromRepository: r upTo: versionNumber]. - ^config! Item was removed: - ----- Method: MCMcmUpdater>>updateFromRepository (in category 'updating') ----- - updateFromRepository - - | config repo | - repo := self getRepositoryFromRepositoryGroup. - repo cacheAllFileNamesDuring: [ | updateList | - updateList := self updateListFor: repo. - "Proceed only if there are updates available at all." - updateList ifNotEmpty: [ - updateList := self refreshUpdateMapFor: repo with: updateList. - "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 {1}' translated format: {assoc value}). - config := repo versionNamed: assoc value. - self updateFromConfig: config. - self lastUpdateMap at: repo description put: assoc key. - ] displayingProgress: 'Processing configurations' translated. - "We've loaded all the provided update configurations. - Use the latest configuration to update all the remaining packages." - (self useLatestPackagesFrom: repo) ifTrue: [ - config updateFromRepositories. - config upgrade]. - ]]. - ^ config - ! Item was removed: - ----- Method: MCMcmUpdater>>updateFromRepository:upTo: (in category 'updating') ----- - updateFromRepository: repository upTo: versionNumber - - | config | - config := nil. - repository cacheAllFileNamesDuring: [ | updateList | - updateList := self updateListFor: repository. - "Proceed only if there are updates available at all." - updateList ifNotEmpty: [ - updateList := self refreshUpdateMapFor: repository with: updateList. - "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| - assoc key > versionNumber ifTrue: [^config]. - ProgressNotification signal: '' extra: ('Processing ' translated format: {assoc value}). - config := repository versionNamed: assoc value. - self updateFromConfig: config. - self lastUpdateMap at: repository description put: assoc key. - ] displayingProgress: 'Processing configurations' translated. - ]]. - ^config - ! Item was removed: - ----- Method: MCMcmUpdater>>updateListFor: (in category 'private') ----- - updateListFor: repo - - | updateList allNames minVersion | - updateList := OrderedCollection new. - minVersion := self lastUpdateMap at: repo description ifAbsent: [0]. - "Find all the update-*.mcm files" - allNames := ('Checking {1}' translated format: {repo description}) - displayProgressFrom: 0 to: 1 during: [:bar| - bar value: 0. - repo allFileNamesOrCache ]. - allNames do: [:fileName | | version | - ((fileName endsWith: '.mcm') - and: [fileName packageAndBranchName = self updateMapName - and: [(version := fileName versionNumber) >= minVersion]]) - ifTrue: [updateList add: version -> fileName]]. - ^updateList sort! Item was removed: - ----- Method: MCMcmUpdater>>updateMapName (in category 'accessing') ----- - updateMapName - "Name for update map, without version info" - - ^ updateMapName ifNil: [updateMapName := self class updateMapName]! Item was removed: - ----- Method: MCMcmUpdater>>updateMapName: (in category 'accessing') ----- - updateMapName: aString - "Name for update map, without version info" - updateMapName := aString! Item was removed: - ----- Method: MCMcmUpdater>>updateMessageFor: (in category 'private') ----- - updateMessageFor: previousUpdateLevel - - ^ ('Update completed.<br><br>Version: {1}<br>Update: {3}<b>{2}</b><br><br>Url: <a href="{4}">{4}</{10}><br>Map: ''{5}''<br>CI status: <a href="{8}"><img src="{7}" /> {9}</{10}>{6}' translated format: { - SystemVersion current version. - SystemVersion current highestUpdate. - previousUpdateLevel = SystemVersion current highestUpdate - ifTrue: [''] - ifFalse: [previousUpdateLevel asString, ' -> ']. - self repository. - MCMcmUpdater updateMapName. - SystemVersion current description ifEmpty: [''] ifNotEmpty: [:d | - '<br><br><font face="{2}" size="{3}">{1}</font>' - format: { - d. - Preferences standardButtonFont familyName. - Preferences standardButtonFont pointSize. - }]. - SystemVersion current ciStatusBadgeUrl. - SystemVersion current ciStatusPageUrl. - SystemVersion current ciStatusTimestamp ifNil: ['(build inaccessible!!)' translated]. - "mt: Avoid triggering the Windows Defender. See http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217346.html" - 'a'. - }) asTextFromHtml! Item was removed: - ----- Method: MCMcmUpdater>>useLatestPackagesFrom: (in category 'private') ----- - useLatestPackagesFrom: repo - "for overriding on a per repository basis" - ^true! Item was removed: - MCWriter subclass: #MCMcmWriter - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MonticelloConfigurations'! - - !MCMcmWriter commentStamp: 'dtl 5/10/2010 22:20' prior: 0! - An MCMcmWriter stores an MCConfiguration on a stream in the form of an array specification. - ! Item was removed: - ----- Method: MCMcmWriter class>>fileOut:on: (in category 'writing') ----- - fileOut: aConfiguration on: aStream - | inst | - inst := self on: aStream. - inst writeConfiguration: aConfiguration. - inst close. - - ! Item was removed: - ----- Method: MCMcmWriter class>>readerClass (in category 'accessing') ----- - readerClass - ^ MCMcmReader! Item was removed: - ----- Method: MCMcmWriter>>close (in category 'writing') ----- - close - stream close! Item was removed: - ----- Method: MCMcmWriter>>writeConfiguration: (in category 'writing') ----- - writeConfiguration: aConfiguration - aConfiguration fileOutOn: stream. - ! Item was removed: - RWBinaryOrTextStream subclass: #MCPseudoFileStream - instanceVariableNames: 'localName' - classVariableNames: '' - poolDictionaries: '' - category: 'MonticelloConfigurations'! - - !MCPseudoFileStream commentStamp: '<historical>' prior: 0! - A pseudo file stream which can be used for updates.! Item was removed: - ----- Method: MCPseudoFileStream>>localName (in category 'accessing') ----- - localName - ^localName! Item was removed: - ----- Method: MCPseudoFileStream>>localName: (in category 'accessing') ----- - localName: aString - localName := aString! Item was removed: - ----- Method: MCRepository class>>supportsConfigurations (in category '*monticelloconfigurations') ----- - supportsConfigurations - ^ false! Item was removed: - (PackageInfo named: 'MonticelloConfigurations') postscript: '"below, add code to be run after the loading of this package" - MCConfiguration upgradeIsMerge: Preferences upgradeIsMerge.'!
More information about the Squeak-dev mailing list |