[squeak-dev] The Trunk: Monticello-cmm.420.mcz

Levente Uzonyi leves at elte.hu
Tue Mar 1 03:53:04 UTC 2011


On Mon, 28 Feb 2011, commits at source.squeak.org wrote:

> Chris Muller uploaded a new version of Monticello to project The Trunk:
> http://source.squeak.org/trunk/Monticello-cmm.420.mcz
>
> ==================== Summary ====================
>
> Name: Monticello-cmm.420
> Author: cmm
> Time: 28 February 2011, 5:56:10.518 pm
> UUID: 371e0e9e-0e88-467f-9aec-22ab7e684c3f
> Ancestors: Monticello-cmm.419
>
> NOTE:  Please close all MC repository browsers before loading this (via the trunk-update process).

This should be ensured by the preamble of the package.


Levente

>
> - Introduced MCFileName for working with Strings in the format [Package]-[author].[version].mcz.
> - Working toward re-unification of MCFileRepositoryInspector's and MCRepositoryInspector's so that MC browsers on a GOODS or Magma-backed MC repository will behave the same as one backed by a file-system.
>
> =============== Diff against Monticello-cmm.419 ===============
>
> Item was changed:
>  SystemOrganization addCategory: #'Monticello-Base'!
>  SystemOrganization addCategory: #'Monticello-Chunk Format'!
>  SystemOrganization addCategory: #'Monticello-Loading'!
>  SystemOrganization addCategory: #'Monticello-Merging'!
>  SystemOrganization addCategory: #'Monticello-Modeling'!
>  SystemOrganization addCategory: #'Monticello-Patching'!
>  SystemOrganization addCategory: #'Monticello-Repositories'!
>  SystemOrganization addCategory: #'Monticello-Storing'!
>  SystemOrganization addCategory: #'Monticello-UI'!
> + SystemOrganization addCategory: #'Monticello-Utilities'!
>  SystemOrganization addCategory: #'Monticello-Versioning'!
>
> Item was added:
> + Object subclass: #MCFileName
> + 	instanceVariableNames: 'packageName author extension versionNumber fileName'
> + 	classVariableNames: ''
> + 	poolDictionaries: ''
> + 	category: 'Monticello-Modeling'!
> +
> + !MCFileName commentStamp: 'cmm 2/28/2011 16:05' prior: 0!
> + A MCFileName models the Monticello file / version name, in the format [Package]-[Author].[version-number].[mc?].
> +
> + The final file-extension only applies to filenames, not version names.
> +
> + Instance Variables
> + 	author:		<String>
> + 	extension:		<String>
> + 	fileName:		<String>
> + 	packageName:		<String>
> + 	versionNumber:		<Integer>!
>
> Item was added:
> + ----- Method: MCFileName classSide>>on: (in category 'create') -----
> + on: aString
> + 	"aString may be with or without a mc? extension."
> + 	^ self new
> + 		filename: aString ;
> + 		yourself!
>
> Item was added:
> + ----- Method: MCFileName>>= (in category 'testing') -----
> + = aMCFileName
> + 	self == aMCFileName ifTrue: [ ^ true ].
> + 	self species = aMCFileName species ifFalse: [ ^ false ].
> + 	^ self versionNumber = aMCFileName versionNumber and:
> + 		[ self author = aMCFileName author and: [ self packageName = aMCFileName packageName ] ]!
>
> Item was added:
> + ----- Method: MCFileName>>author (in category 'access') -----
> + author
> + 	"The author initials embedded in the filename."
> + 	^ author!
>
> Item was added:
> + ----- Method: MCFileName>>extension (in category 'access') -----
> + extension
> + 	"The filename's extension."
> + 	^ extension!
>
> Item was added:
> + ----- Method: MCFileName>>fileName (in category 'access') -----
> + fileName
> + 	^ fileName!
>
> Item was added:
> + ----- Method: MCFileName>>filename: (in category 'initializing') -----
> + filename: aString
> + 	"Parse aString which is assumed to be either a MC filename [Package]-[author].[versionNumber], with or without a .mc? extension."
> + 	| name |
> + 	fileName := aString.
> + 	name := (aString copyUpToLast: $.) copyUpTo: $(.
> + 	packageName := name copyUpToLast: $-.
> + 	author := (name copyAfterLast: $-) copyUpTo: $..
> + 	versionNumber := name last isDigit
> + 		ifTrue:
> + 			[ extension := aString copyAfterLast: $..
> + 			((name copyAfterLast: $-) copyAfter: $.) asInteger ifNil: [ 0 ] ]
> + 		ifFalse: [ ((aString copyAfterLast: $-) copyAfter: $.) asInteger ifNil: [ 0 ] ]!
>
> Item was added:
> + ----- Method: MCFileName>>hash (in category 'testing') -----
> + hash
> + 	^ ((self versionNumber hash + self author hash hashMultiply) hashMultiply + self packageName hash) hashMultiply!
>
> Item was added:
> + ----- Method: MCFileName>>isValid (in category 'testing') -----
> + isValid
> + 	^ {  packageName. author. extension. versionNumber  } allSatisfy: [ : e | e notNil ]!
>
> Item was added:
> + ----- Method: MCFileName>>packageName (in category 'access') -----
> + packageName
> + 	"The MC Package name embedded into this filename."
> + 	^ packageName!
>
> Item was added:
> + ----- Method: MCFileName>>versionNumber (in category 'access') -----
> + versionNumber
> + 	"The version number identified by this filename."
> + 	^ versionNumber!
>
> Item was changed:
>  MCVersionInspector subclass: #MCFileRepositoryInspector
> + 	instanceVariableNames: 'repository versions selectedPackage selectedVersion order versionInfo packageList'
> - 	instanceVariableNames: 'repository versions loaded newer inherited selectedPackage selectedVersion order versionInfo packageList'
>  	classVariableNames: 'Order'
>  	poolDictionaries: ''
>  	category: 'Monticello-UI'!
>
> Item was added:
> + ----- Method: MCFileRepositoryInspector>>hasNewerVersionsFor: (in category 'private') -----
> + hasNewerVersionsFor: aMCWorkingCopy
> + 	| latest |
> + 	latest := (versions select:
> + 		[ : eachMCFileName | eachMCFileName packageName = aMCWorkingCopy package name ]) detectMax:
> + 		[ : eachMCFileName | eachMCFileName versionNumber ].
> + 	^ latest notNil and:
> + 		[ aMCWorkingCopy ancestors allSatisfy:
> + 			[ : ancestor | | loadedVersionNumber ancestorName |
> + 			ancestorName := ancestor mcName.
> + 			loadedVersionNumber := ancestorName versionNumber.
> + 			loadedVersionNumber < latest versionNumber or:
> + 				[ loadedVersionNumber = latest versionNumber and: [ ancestorName author ~= latest author ] ] ] ]!
>
> Item was changed:
> + ----- Method: MCFileRepositoryInspector>>load (in category 'actions') -----
> - ----- Method: MCFileRepositoryInspector>>load (in category 'as yet unclassified') -----
>  load
>  	self hasVersion ifTrue:
>  		[self version isCacheable
>  			ifTrue: [version workingCopy repositoryGroup addRepository: repository].
>  		super load.
>  		self refresh].!
>
> Item was changed:
> + ----- Method: MCFileRepositoryInspector>>merge (in category 'actions') -----
> - ----- Method: MCFileRepositoryInspector>>merge (in category 'as yet unclassified') -----
>  merge
>  	super merge.
>  	self refresh.
>  !
>
> Item was changed:
>  ----- Method: MCFileRepositoryInspector>>orderSpecs (in category 'morphic ui') -----
>  orderSpecs
>  	^{
>  		'unchanged' -> nil.
> + 		'order by package' -> [ :x :y | x packageName < y packageName ].
> + 		'order by author' -> [ :x :y | x author < y author ].
> + 		'order by version-string' -> [ :x :y | x versionNumber asString < y versionNumber asString ].
> + 		'order by version-number' -> [ :x :y | x versionNumber > y versionNumber ].
> + 		'order by filename' -> [ :x :y | x fileName < y fileName ].
> - 		'order by package' -> [ :x :y | x first <= y first ].
> - 		'order by author' -> [ :x :y | x second <= y second ].
> - 		'order by version-string' -> [ :x :y | x third <= y third ].
> - 		'order by version-number' -> [ :x :y | x third asNumber >= y third asNumber ].
> - 		'order by filename' -> [ :x :y | x fourth <= y fourth ].
>  	}!
>
> Item was changed:
>  ----- Method: MCFileRepositoryInspector>>packageHighlight: (in category 'morphic ui') -----
> + packageHighlight: aString
> + 	newer ifNil: [ newer := #() ].
> + 	^ (loaded anySatisfy:
> + 		[ : each | each packageName = aString ])
> + 		ifTrue:
> + 			[ Text
> + 				string: aString
> + 				attribute:
> + 					(TextEmphasis new emphasisCode:
> + 						((newer includes: aString)
> + 							ifTrue: [ 5 ]
> + 							ifFalse: [ 4 ])) ]
> + 		ifFalse: [ aString ]!
> - packageHighlight: aString
> -
> - 	newer ifNil: [newer := #()].
> - 	^(loaded anySatisfy: [:each | (each copyUpToLast: $-) = aString])
> - 		ifTrue: [
> - 			Text string: aString
> - 				attribute: (TextEmphasis new emphasisCode: (
> - 					((newer includes: aString)
> - 						ifTrue: [5] ifFalse: [4])))]
> - 		ifFalse: [aString]!
>
> Item was changed:
>  ----- Method: MCFileRepositoryInspector>>packageList (in category 'morphic ui') -----
>  packageList
>
>  	| result loadedPackages |
>  	packageList ifNotNil: [ ^packageList ].
>  	result := Set new: versions size.
> + 	versions do: [ :each | result add: each packageName ].
> - 	versions do: [ :each | result add: each first ].
>
>  	"sort loaded packages first, then alphabetically"
>  	loadedPackages := Set new: loaded size.
>  	loaded do: [ :each |
> + 		loadedPackages add: (each packageName) ].
> - 		loadedPackages add: (each copyUpToLast: $-) ].
>  	result := result asArray sort: [ :a :b |
>  		| loadedA loadedB |
>  		loadedA := loadedPackages includes: a.
>  		loadedB := loadedPackages includes: b.
>  		loadedA = loadedB
>  			ifTrue: [ a < b ]
>  			ifFalse: [ loadedA ] ].
>
>  	^packageList := result collect: [ :each | self packageHighlight: each ]!
>
> Item was changed:
> + ----- Method: MCFileRepositoryInspector>>refresh (in category 'actions') -----
> - ----- Method: MCFileRepositoryInspector>>refresh (in category 'as yet unclassified') -----
>  refresh
> - 	| packageNames |
> - 	packageNames := Set new.
>  	packageList := nil.
> + 	versions := repository readableFileNames collect: [ : each | MCFileName on: each ].
> + 	self
> + 		 refreshEmphasis ;
> + 		 changed: #packageList ;
> + 		 changed: #versionList!
> - 	versions := repository readableFileNames collect: [ :each | | name |
> - 		name := (each copyUpToLast: $.) copyUpTo: $(.
> - 		name last isDigit ifFalse: [Array with: name with: '' with: '' with: each]
> - 			ifTrue:
> - 				[Array
> - 					with: (packageNames add: (name copyUpToLast:  $-))		"pkg name"
> - 					with: ((name copyAfterLast: $-) copyUpTo: $.)				"user"
> - 					with: (((name copyAfterLast: $-) copyAfter: $.) asInteger ifNil: [ 0 ])	"version"
> - 					with: each]].
> - 	newer := Set new.
> - 	inherited := Set new.
> - 	loaded := Set new.
> - 	(MCWorkingCopy allManagers
> - "		select: [ :each | packageNames includes: each packageName]")
> - 		do: [:each | | latest |
> - 			each ancestors do: [ :ancestor |
> - 				loaded add: ancestor name.
> - 				ancestor ancestorsDoWhileTrue: [:heir |
> - 					(inherited includes: heir name)
> - 						ifTrue: [false]
> - 						ifFalse: [inherited add: heir name. true]]].
> - 			latest := (versions select: [:v | v first = each package name])
> - 				detectMax: [:v | v third].
> - 			(latest notNil and: [
> - 				each ancestors allSatisfy: [:ancestor | | av |
> - 					av := ((ancestor name copyAfterLast: $-) copyAfter: $.) asInteger.
> - 					av < latest third or: [
> - 						av = latest third and: [((ancestor name copyAfterLast: $-) copyUpTo: $.) ~= latest second]]]])
> - 				ifTrue: [newer add: each package name ]].
> -
> - 	self changed: #packageList; changed: #versionList!
>
> Item was changed:
> + ----- Method: MCFileRepositoryInspector>>setRepository:workingCopy: (in category 'initialize-release') -----
> - ----- Method: MCFileRepositoryInspector>>setRepository:workingCopy: (in category 'as yet unclassified') -----
>  setRepository: aFileBasedRepository workingCopy: aWorkingCopy
>  	order := self class order.
>  	repository := aFileBasedRepository.
>  	self refresh.
>  	aWorkingCopy
>  		ifNil: [selectedPackage := self packageList isEmpty ifFalse: [self packageList first]]
>  		ifNotNil: [ selectedPackage := aWorkingCopy ancestry ancestorString copyUpToLast: $- ].
>  	MCWorkingCopy addDependent: self.
>  !
>
> Item was changed:
>  ----- Method: MCFileRepositoryInspector>>versionList (in category 'morphic ui') -----
>  versionList
> -
>  	| result |
>  	result := selectedPackage
>  		ifNil: [ versions copy ]
> + 		ifNotNil:
> + 			[ versions select:
> + 				[ : each | selectedPackage = each packageName ] ].
> + 	"Not sure why we need this ugly Error trapping here.."
> + 	(self orderSpecs at: order) value ifNotNil:
> + 		[ : sortBlock | result sort:
> + 			[ : a : b | [ sortBlock
> + 				value: a
> + 				value: b ]
> + 				on: Error
> + 				do: [ true ] ] ].
> + 	^ result replace:
> + 		[ : each | self versionHighlight: each fileName ]!
> - 		ifNotNil: [ versions select: [ :each | selectedPackage = each first ] ].
> - 	(self orderSpecs at: order) value ifNotNil: [ :sortBlock |
> - 		result sort: [:a :b | [ sortBlock value: a value: b ] on: Error do: [ true ] ] ].
> - 	^result 	replace: [ :each | self versionHighlight: each fourth ]!
>
> Item was changed:
>  MCVersionInspector subclass: #MCRepositoryInspector
> + 	instanceVariableNames: 'repository packages versions selectedPackage selectedVersion'
> - 	instanceVariableNames: 'repository packages versions loaded selectedPackage selectedVersion'
>  	classVariableNames: ''
>  	poolDictionaries: ''
>  	category: 'Monticello-UI'!
>
> Item was changed:
> + ----- Method: MCRepositoryInspector>>hasVersion (in category 'morphic ui') -----
> - ----- Method: MCRepositoryInspector>>hasVersion (in category 'as yet unclassified') -----
>  hasVersion
>  	^ selectedVersion notNil!
>
> Item was changed:
> + ----- Method: MCRepositoryInspector>>load (in category 'accessing') -----
> - ----- Method: MCRepositoryInspector>>load (in category 'as yet unclassified') -----
>  load
>  	self hasVersion ifTrue:
>  		[super load.
>  		self version workingCopy repositoryGroup addRepository: repository].!
>
> Item was changed:
> + ----- Method: MCRepositoryInspector>>refresh (in category 'accessing') -----
> - ----- Method: MCRepositoryInspector>>refresh (in category 'as yet unclassified') -----
>  refresh
>  	packages := repository packages.
>  	self changed: #packageList.
>  	self packageSelection: self packageSelection.
>  !
>
> Item was changed:
> + ----- Method: MCRepositoryInspector>>setRepository:workingCopy: (in category 'initialize-release') -----
> - ----- Method: MCRepositoryInspector>>setRepository:workingCopy: (in category 'as yet unclassified') -----
>  setRepository: aRepository workingCopy: aWorkingCopy
>  	repository := aRepository.
>  	aWorkingCopy isNil ifFalse: [ selectedPackage := aWorkingCopy package].
>  	self refresh!
>
> Item was changed:
> + ----- Method: MCRepositoryInspector>>summary (in category 'accessing') -----
> - ----- Method: MCRepositoryInspector>>summary (in category 'as yet unclassified') -----
>  summary
>  	^ selectedVersion
>  		ifNotNil: [selectedVersion summary]
>  		ifNil: ['']!
>
> Item was changed:
> + ----- Method: MCRepositoryInspector>>version (in category 'accessing') -----
> - ----- Method: MCRepositoryInspector>>version (in category 'as yet unclassified') -----
>  version
>  	^ version ifNil: [version := repository versionWithInfo: selectedVersion]!
>
> Item was added:
> + ----- Method: MCVersionInfo>>mcName (in category 'accessing') -----
> + mcName
> + 	^ MCFileName on: self name!
>
> Item was changed:
>  MCTool subclass: #MCVersionInspector
> + 	instanceVariableNames: 'version loaded newer inherited'
> - 	instanceVariableNames: 'version'
>  	classVariableNames: ''
>  	poolDictionaries: ''
>  	category: 'Monticello-UI'!
>
> Item was changed:
> + ----- Method: MCVersionInspector>>adopt (in category 'accessing') -----
> - ----- Method: MCVersionInspector>>adopt (in category 'as yet unclassified') -----
>  adopt
>  	(self confirm:
>  'Modifying ancestry can be dangerous unless you know
>  what you are doing.  Are you sure you want to adopt
>  ',self version info name, ' as an ancestor of your working copy?')
>  		ifTrue: [self version adopt]!
>
> Item was changed:
> + ----- Method: MCVersionInspector>>browse (in category 'accessing') -----
> - ----- Method: MCVersionInspector>>browse (in category 'as yet unclassified') -----
>  browse
>  	self version browse!
>
> Item was changed:
> + ----- Method: MCVersionInspector>>changes (in category 'accessing') -----
> - ----- Method: MCVersionInspector>>changes (in category 'as yet unclassified') -----
>  changes
>  	(MCPatchBrowser forPatch: self version changes)
>  		showLabelled: 'Changes from ', self version info name!
>
> Item was changed:
> + ----- Method: MCVersionInspector>>diff (in category 'accessing') -----
> - ----- Method: MCVersionInspector>>diff (in category 'as yet unclassified') -----
>  diff
>  	| ancestorVersion |
>  	self pickAncestor ifNotNil:
>  		[:ancestor |
>  		ancestorVersion := self version workingCopy repositoryGroup versionWithInfo: ancestor.
>  		(self version asDiffAgainst: ancestorVersion) open]!
>
> Item was changed:
> + ----- Method: MCVersionInspector>>hasVersion (in category 'accessing') -----
> - ----- Method: MCVersionInspector>>hasVersion (in category 'as yet unclassified') -----
>  hasVersion
>  	^version notNil!
>
> Item was changed:
> + ----- Method: MCVersionInspector>>history (in category 'accessing') -----
> - ----- Method: MCVersionInspector>>history (in category 'as yet unclassified') -----
>  history
>  	(MCVersionHistoryBrowser new ancestry: self versionInfo) show!
>
> Item was added:
> + ----- Method: MCVersionInspector>>identifyLoadedAndInherited: (in category 'private') -----
> + identifyLoadedAndInherited: aMCWorkingCopy
> + 	aMCWorkingCopy ancestors do:
> + 		[ : ancestor | loaded add: ancestor mcName.
> + 		ancestor ancestorsDoWhileTrue:
> + 			[ : heir | (inherited includes: heir name)
> + 				ifTrue: [ false ]
> + 				ifFalse:
> + 					[ inherited add: heir name.
> + 					true ] ] ]!
>
> Item was changed:
> + ----- Method: MCVersionInspector>>load (in category 'accessing') -----
> - ----- Method: MCVersionInspector>>load (in category 'as yet unclassified') -----
>  load
>  	Cursor wait showWhile: [self version load]!
>
> Item was changed:
> + ----- Method: MCVersionInspector>>merge (in category 'accessing') -----
> - ----- Method: MCVersionInspector>>merge (in category 'as yet unclassified') -----
>  merge
>  	self version merge!
>
> Item was added:
> + ----- Method: MCVersionInspector>>refreshEmphasis (in category 'private') -----
> + refreshEmphasis
> + 	newer := Set new.
> + 	inherited := Set new.
> + 	loaded := Set new.
> + 	MCWorkingCopy allManagers do:
> + 		[ : each | | latest |
> + 		self identifyLoadedAndInherited: each.
> + 		(self hasNewerVersionsFor: each) ifTrue: [ newer add: each package name ] ]!
>
> Item was changed:
> + ----- Method: MCVersionInspector>>save (in category 'accessing') -----
> - ----- Method: MCVersionInspector>>save (in category 'as yet unclassified') -----
>  save
>  	self pickRepository ifNotNil:
>  		[:ea |
>  		ea storeVersion: self version]!
>
> Item was changed:
> + ----- Method: MCVersionInspector>>summary (in category 'accessing') -----
> - ----- Method: MCVersionInspector>>summary (in category 'as yet unclassified') -----
>  summary
>  	^self hasVersion
>  		ifTrue: [ self versionSummary ]
>  		ifFalse: [ String new ]!
>
> Item was changed:
> + ----- Method: MCVersionInspector>>version (in category 'accessing') -----
> - ----- Method: MCVersionInspector>>version (in category 'as yet unclassified') -----
>  version
>  	^ version!
>
> Item was changed:
> + ----- Method: MCVersionInspector>>version: (in category 'accessing') -----
> - ----- Method: MCVersionInspector>>version: (in category 'as yet unclassified') -----
>  version: aVersion
>  	version := aVersion!
>
> Item was changed:
> + ----- Method: MCVersionInspector>>versionInfo (in category 'accessing') -----
> - ----- Method: MCVersionInspector>>versionInfo (in category 'as yet unclassified') -----
>  versionInfo
>  	^ self version info!
>
> Item was changed:
> + ----- Method: MCVersionInspector>>versionSummary (in category 'accessing') -----
> - ----- Method: MCVersionInspector>>versionSummary (in category 'as yet unclassified') -----
>  versionSummary
>  	^ self version summary!
>
>
>



More information about the Squeak-dev mailing list