[Pkg] The Trunk: Monticello-cmm.420.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Feb 28 23:56:32 UTC 2011


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

- 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 Packages mailing list