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

commits at source.squeak.org commits at source.squeak.org
Tue Mar 15 19:14:33 UTC 2011


Chris Muller uploaded a new version of Monticello to project The Trunk:
http://source.squeak.org/trunk/Monticello-cmm.438.mcz

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

Name: Monticello-cmm.438
Author: cmm
Time: 15 March 2011, 2:10:56.178 pm
UUID: 00d989ad-efa6-4195-a72f-1c63e0e6a68a
Ancestors: Monticello-cmm.437

- Added MCRepositoryGroup class>>#flushAllCaches convenience method.
- Identifying "newer" packages (so they can be bolded in the package list) is expensive, so only do it when the repository is refreshed, not every time a new package is selected.

=============== Diff against Monticello-ul.422 ===============

Item was changed:
+ (PackageInfo named: 'Monticello') preamble: 'MCFileBasedRepository allSubInstances do: [ : each | each flushCache ]'!
- (PackageInfo named: 'Monticello') preamble: 'SystemWindow allSubInstances
- 	select: [ :each | each model class == MCFileRepositoryInspector ]
- 	thenDo: [ :each | each delete ]'!

Item was added:
+ 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'!
+ SystemOrganization addCategory: #'Monticello-Mocks'!
+ SystemOrganization addCategory: #Monticello!

Item was removed:
- 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:
+ ----- Method: ByteString>>asMCVersionName (in category '*monticello') -----
+ asMCVersionName 
+ 	^ MCVersionName on: self!

Item was added:
+ ----- Method: ByteSymbol>>asMCVersionName (in category '*monticello') -----
+ asMCVersionName
+ 	^ self asString asMCVersionName!

Item was added:
+ ----- Method: Class>>workingCopy (in category '*monticello') -----
+ workingCopy
+ 	^ self packageInfo workingCopy!

Item was changed:
  ----- Method: MCAncestry>>ancestors (in category 'ancestry') -----
  ancestors
+ 	^ ancestors ifNil: [ Array empty ]!
- 	^ ancestors ifNil: [#()]!

Item was changed:
  ----- Method: MCAncestry>>hasAncestor: (in category 'ancestry') -----
  hasAncestor: aVersionInfo
+ 	"Answer whether the receiver has ancestor, aVersionInfo."
+ "Would it be more performant to use a Set for alreadySeen:?"
  	^ self
  		hasAncestor: aVersionInfo
  		alreadySeen: OrderedCollection new!

Item was added:
+ ----- Method: MCAncestry>>names (in category 'ancestry') -----
+ names
+ 	"The names of the ancestors."
+ 	^ self ancestors collect: [ : each | each name asMCVersionName ]!

Item was added:
+ ----- Method: MCClassDefinition>>workingCopy (in category 'accessing') -----
+ workingCopy
+ 	^ self actualClass workingCopy!

Item was added:
+ ----- Method: MCDefinition>>repositoryGroup (in category 'repositories') -----
+ repositoryGroup
+ 	"Answer the MCRepositoryGroup from which this this object was loaded."
+ 	^ self workingCopy repositoryGroup!

Item was added:
+ ----- Method: MCDefinition>>workingCopy (in category 'repositories') -----
+ workingCopy
+ 	self subclassResponsibility!

Item was changed:
  ----- Method: MCDictionaryRepository>>includesVersionNamed: (in category 'as yet unclassified') -----
+ includesVersionNamed: aString 
+ 	| mcVersionName |
+ 	mcVersionName := aString asMCVersionName.
+ 	^ dict anySatisfy:
+ 		[ : ea | ea info versionName = mcVersionName ]!
- includesVersionNamed: aString
- 	^ dict anySatisfy: [:ea | ea info name = aString]!

Item was removed:
- ----- Method: MCDictionaryRepository>>versionNamed:ifAbsent: (in category 'versions') -----
- versionNamed: versionName ifAbsent: aBlock
- 	"Answer the MCVersion corresponding to the given version name"
- 
- 	^dict detect:[:any| any info name = versionName] ifNone: aBlock
- !

Item was changed:
  ----- Method: MCDiffyVersion class>>nameForVer:base: (in category 'name utilities') -----
  nameForVer: versionName base: baseName
  	| baseId |
+ 	baseId := versionName = baseName
+ 		ifTrue: [ baseName versionNumber asString ]
+ 		ifFalse:
+ 			[ versionName packageName = baseName packageName
+ 				ifTrue: [ baseName author, '.', baseName versionNumber asString ]
+ 				ifFalse: [ '@' , baseName ] ].
+ 	^ versionName versionName , '(' , baseId , ')'!
- 	baseId := (versionName copyUpToLast: $.) = (baseName copyUpToLast: $.)
- 		ifTrue: [baseName copyAfterLast: $.]
- 		ifFalse: [(versionName copyUpToLast: $-) = (baseName copyUpToLast: $-)
- 			ifTrue: [baseName copyAfterLast: $-]
- 			ifFalse: ['@', baseName]].
- 	^ versionName, '(', baseId, ')'!

Item was changed:
  ----- Method: MCDiffyVersion>>fileName (in category 'as yet unclassified') -----
  fileName
+ 	^ ((self class
+ 		nameForVer: info name
+ 		base: base name) , '.' , self writerClass extension) asMCVersionName!
- 	^ (self class nameForVer: info name base: base name), '.', self writerClass extension!

Item was changed:
  ----- Method: MCDirectoryRepository>>allFileNames (in category 'as yet unclassified') -----
  allFileNames
+ 	^ (directory entries sortBy: [:a :b | a modificationTime >= b modificationTime]) collect: [:ea | ea name asMCVersionName]!
- 	^ (directory entries sortBy: [:a :b | a modificationTime >= b modificationTime]) collect: [:ea | ea name]!

Item was changed:
+ ----- Method: MCFileBasedRepository>>allFileNames (in category 'private-files') -----
- ----- Method: MCFileBasedRepository>>allFileNames (in category 'files') -----
  allFileNames
  	self subclassResponsibility!

Item was changed:
+ ----- Method: MCFileBasedRepository>>allFileNamesForVersionNamed: (in category 'private-files') -----
+ allFileNamesForVersionNamed: aMCVersionName 
+ 	^ self
+ 		filterFileNames: self readableFileNames
+ 		forVersionNamed: aMCVersionName!
- ----- Method: MCFileBasedRepository>>allFileNamesForVersionNamed: (in category 'files') -----
- allFileNamesForVersionNamed: aString
- 	^ self filterFileNames: self readableFileNames forVersionNamed: aString!

Item was changed:
+ ----- Method: MCFileBasedRepository>>allFileNamesOrCache (in category 'private-files') -----
- ----- Method: MCFileBasedRepository>>allFileNamesOrCache (in category 'files') -----
  allFileNamesOrCache
  	^ allFileNames ifNil: [self allFileNames]!

Item was added:
+ ----- Method: MCFileBasedRepository>>allPackageNames (in category 'overriding') -----
+ allPackageNames
+ 	| answer |
+ 	answer := Set new.
+ 	self allFileNamesOrCache do:
+ 		[ : each | | versionName |
+ 		versionName := each asMCVersionName.
+ 		versionName isValid ifTrue: [ answer add: versionName packageName ] ].
+ 	^ answer!

Item was changed:
+ ----- Method: MCFileBasedRepository>>allVersionNames (in category 'private-files') -----
- ----- Method: MCFileBasedRepository>>allVersionNames (in category 'versions') -----
  allVersionNames
+ 	^ self readableFileNames!
- 	^ self readableFileNames collect: [:ea | self versionNameFromFileName: ea]!

Item was changed:
+ ----- Method: MCFileBasedRepository>>canReadFileNamed: (in category 'private-files') -----
- ----- Method: MCFileBasedRepository>>canReadFileNamed: (in category 'private') -----
  canReadFileNamed: aString
  	| reader |
  	reader := MCVersionReader readerClassForFileNamed: aString.
  	^ reader notNil!

Item was changed:
+ ----- Method: MCFileBasedRepository>>filterFileNames:forVersionNamed: (in category 'private-files') -----
+ filterFileNames: aCollection forVersionNamed: aMCVersionName 
+ 	^ aCollection select:
+ 		[ : ea | aMCVersionName = ea ]!
- ----- Method: MCFileBasedRepository>>filterFileNames:forVersionNamed: (in category 'files') -----
- filterFileNames: aCollection forVersionNamed: aString
- 	^ aCollection select: [:ea | (self versionNameFromFileName: ea) = aString] !

Item was changed:
  ----- Method: MCFileBasedRepository>>includesVersionNamed: (in category 'versions') -----
  includesVersionNamed: aString
+ 	^ self allVersionNames includes: aString asMCVersionName!
- 	^ self allVersionNames includes: aString!

Item was changed:
+ ----- Method: MCFileBasedRepository>>loadVersionFromFileNamed: (in category 'private-files') -----
- ----- Method: MCFileBasedRepository>>loadVersionFromFileNamed: (in category 'versions') -----
  loadVersionFromFileNamed: aString
  	^ self versionReaderForFileNamed: aString do: [:r | r version]!

Item was changed:
+ ----- Method: MCFileBasedRepository>>loadVersionInfoFromFileNamed: (in category 'private-files') -----
- ----- Method: MCFileBasedRepository>>loadVersionInfoFromFileNamed: (in category 'versions') -----
  loadVersionInfoFromFileNamed: aString
  	^ self versionReaderForFileNamed: aString do: [:r | r info]
  	!

Item was removed:
- ----- Method: MCFileBasedRepository>>possiblyNewerVersionsOfAnyOf: (in category 'versions') -----
- possiblyNewerVersionsOfAnyOf: someVersions
- 	| pkgs |
- 	pkgs := Dictionary new.
- 
- 	someVersions do: [:aVersionInfo |
- 		pkgs at: (aVersionInfo name copyUpToLast: $-)
- 			put: (aVersionInfo name copyAfterLast: $.) asNumber].
- 
- 	^[self allVersionNames select: [:each |
- 		(pkgs at: (each copyUpToLast: $-) ifPresent: [:verNumber |
- 			verNumber < (each copyAfterLast: $.) asNumber
- 				or: [verNumber = (each copyAfterLast: $.) asNumber
- 					and: [someVersions noneSatisfy: [:v | v name = each]]]]) == true]
- 	] on: Error do: [:ex | ex return: #()]!

Item was changed:
+ ----- Method: MCFileBasedRepository>>readableFileNames (in category 'private-files') -----
- ----- Method: MCFileBasedRepository>>readableFileNames (in category 'files') -----
  readableFileNames
+ 	"Answer an Array of MCVersionNames representing every file in this repository; first the ones from the cache (whether or not they still exist in the repository) followed by every other file in this repository that Monticello can read."
  	| all cached new |
  	all := self allFileNamesOrCache.	"from repository"
  	cached := self cachedFileNames.	"in memory"
  	new := all difference: cached.
  	^ (cached asArray, new)
  		select: [:ea | self canReadFileNamed: ea]!

Item was removed:
- ----- Method: MCFileBasedRepository>>versionFromFileNamed: (in category 'versions') -----
- versionFromFileNamed: aString
- 	| v |
- 	v := self cache at: aString ifAbsent: [self loadVersionFromFileNamed: aString].
- 	self resizeCache: cache.
- 	(v notNil and: [v isCacheable]) ifTrue: [cache at: aString put: v].
- 	^ v!

Item was changed:
+ ----- Method: MCFileBasedRepository>>versionInfoFromFileNamed: (in category 'private-files') -----
- ----- Method: MCFileBasedRepository>>versionInfoFromFileNamed: (in category 'versions') -----
  versionInfoFromFileNamed: aString
  	self cache at: aString ifPresent: [:v | ^ v info].
  	^ self loadVersionInfoFromFileNamed: aString!

Item was removed:
- ----- Method: MCFileBasedRepository>>versionNameFromFileName: (in category 'versions') -----
- versionNameFromFileName: aString
- 	^ (aString copyUpToLast: $.) copyUpTo: $(!

Item was added:
+ ----- Method: MCFileBasedRepository>>versionNamed: (in category 'versions') -----
+ versionNamed: aMCVersionName
+ 	"For FileBased repositories, aMCVersionName must have the appropriate extension!!  :-("
+ 	| v |
+ 	v := self cache at: aMCVersionName ifAbsent: [self loadVersionFromFileNamed: aMCVersionName].
+ 	self resizeCache: cache.
+ 	(v notNil and: [v isCacheable]) ifTrue: [cache at: aMCVersionName asMCVersionName put: v].
+ 	^ v!

Item was removed:
- ----- Method: MCFileBasedRepository>>versionNamed:ifAbsent: (in category 'versions') -----
- versionNamed: versionName ifAbsent: aBlock
- 	"Answer the MCVersion corresponding to the given version name"
- 
- 	(self allFileNamesForVersionNamed: versionName) do:[:fileName | 
- 		| version |
- 		version := self versionFromFileNamed: fileName.
- 		version info name = versionName ifTrue: [^version].
- 	].
- 	^aBlock value!

Item was added:
+ ----- Method: MCFileBasedRepository>>versionNamesForPackageNamed: (in category 'versions') -----
+ versionNamesForPackageNamed: packageName 
+ 	^ Array streamContents:
+ 		[ : stream | self allFileNamesOrCache do:
+ 			[ : each | | mcVersionName |
+ 			mcVersionName := each asMCVersionName.
+ 			mcVersionName packageName = packageName ifTrue: [ stream nextPut: mcVersionName ] ] ]!

Item was changed:
+ ----- Method: MCFileBasedRepository>>versionReaderForFileNamed:do: (in category 'private-files') -----
- ----- Method: MCFileBasedRepository>>versionReaderForFileNamed:do: (in category 'versions') -----
  versionReaderForFileNamed: aString do: aBlock
  	^ self
  		readStreamForFileNamed: aString
  		do: [:s |
  			(MCVersionReader readerClassForFileNamed: aString) ifNotNil:
  				[:class | aBlock value: (class on: s fileName: aString)]]
  !

Item was changed:
  ----- Method: MCFileBasedRepository>>versionWithInfo:ifAbsent: (in category 'versions') -----
  versionWithInfo: aVersionInfo ifAbsent: errorBlock
+ 	(self allFileNamesForVersionNamed: aVersionInfo versionName) do:
- 	
- 	(self allFileNamesForVersionNamed: aVersionInfo name) do:
  		[:fileName | | version |
+ 		version := self versionNamed: fileName.
- 		version := self versionFromFileNamed: fileName.
  		version info = aVersionInfo ifTrue: [^ version]].
  	^ errorBlock value!

Item was changed:
+ ----- Method: MCFileBasedRepository>>writeStreamForFileNamed:do: (in category 'private-files') -----
- ----- Method: MCFileBasedRepository>>writeStreamForFileNamed:do: (in category 'private') -----
  writeStreamForFileNamed: aString do: aBlock
  	^ self writeStreamForFileNamed: aString replace: false do: aBlock!

Item was removed:
- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: MCFileName>>author (in category 'access') -----
- author
- 	"The author initials embedded in the filename."
- 	^ author!

Item was removed:
- ----- Method: MCFileName>>extension (in category 'access') -----
- extension
- 	"The filename's extension."
- 	^ extension!

Item was removed:
- ----- Method: MCFileName>>fileName (in category 'access') -----
- fileName
- 	^ fileName!

Item was removed:
- ----- 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 removed:
- ----- Method: MCFileName>>hash (in category 'testing') -----
- hash
- 	^ ((self versionNumber hash + self author hash hashMultiply) hashMultiply + self packageName hash) hashMultiply!

Item was removed:
- ----- Method: MCFileName>>isValid (in category 'testing') -----
- isValid
- 	^ {  packageName. author. extension. versionNumber  } allSatisfy: [ : e | e notNil ]!

Item was removed:
- ----- Method: MCFileName>>packageName (in category 'access') -----
- packageName
- 	"The MC Package name embedded into this filename."
- 	^ packageName!

Item was removed:
- ----- Method: MCFileName>>printOn: (in category 'printing') -----
- printOn: aStream 
- 	super printOn: aStream.
- 	aStream
- 		 space ;
- 		 nextPutAll: self fileName!

Item was removed:
- ----- Method: MCFileName>>versionName (in category 'access') -----
- versionName
- 	"Answer my version name, without the file suffix."
- 	^ extension
- 		ifNil: [ fileName ]
- 		ifNotNil:
- 			[ String streamContents:
- 				[ : stream | stream
- 					 nextPutAll: self packageName ;
- 					 nextPut: $- ;
- 					 nextPutAll: self author ;
- 					 nextPut: $. ;
- 					 nextPutAll: self versionNumber asString ] ]!

Item was removed:
- ----- Method: MCFileName>>versionNumber (in category 'access') -----
- versionNumber
- 	"The version number identified by this filename."
- 	^ versionNumber!

Item was changed:
+ MCRepositoryInspector subclass: #MCFileRepositoryInspector
+ 	instanceVariableNames: 'allVersionNames'
+ 	classVariableNames: ''
- MCVersionInspector subclass: #MCFileRepositoryInspector
- 	instanceVariableNames: 'repository versions selectedPackage selectedVersion order versionInfo packageList'
- 	classVariableNames: 'Order'
  	poolDictionaries: ''
  	category: 'Monticello-UI'!

Item was removed:
- ----- Method: MCFileRepositoryInspector class>>initialize (in category 'class initialization') -----
- initialize
- 	"self initialize"
- 
- 	self migrateInstances!

Item was removed:
- ----- Method: MCFileRepositoryInspector class>>migrateInstances (in category 'class initialization') -----
- migrateInstances
- 	self allSubInstancesDo: [:inst |
- 		#(packageList versionList) do: [:each |
- 			[(inst findListMorph: each) highlightSelector: nil]
- 				on: Error do: [:ignore | ]]].!

Item was removed:
- ----- Method: MCFileRepositoryInspector class>>order (in category 'as yet unclassified') -----
- order
- 	Order isNil
- 		ifTrue: [ Order := 5 ].
- 	^Order!

Item was removed:
- ----- Method: MCFileRepositoryInspector class>>order: (in category 'as yet unclassified') -----
- order: anInteger
- 	Order := anInteger!

Item was removed:
- ----- Method: MCFileRepositoryInspector class>>repository:workingCopy: (in category 'as yet unclassified') -----
- repository: aFileBasedRepository workingCopy: aWorkingCopy
- 	^self new
- 		setRepository: aFileBasedRepository workingCopy: aWorkingCopy;
- 		yourself!

Item was added:
+ ----- Method: MCFileRepositoryInspector>>allVersionNames (in category 'private') -----
+ allVersionNames
+ 	^ allVersionNames ifNil:
+ 		[ self initializeVersionNames.
+ 		allVersionNames ]!

Item was removed:
- ----- Method: MCFileRepositoryInspector>>defaultExtent (in category 'morphic ui') -----
- defaultExtent
- 	^450 at 300!

Item was removed:
- ----- Method: MCFileRepositoryInspector>>defaultLabel (in category 'morphic ui') -----
- defaultLabel
- 	^'Repository: ' , repository description!

Item was removed:
- ----- 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 removed:
- ----- Method: MCFileRepositoryInspector>>hasVersion (in category 'morphic ui') -----
- hasVersion
- 	^ selectedVersion notNil!

Item was added:
+ ----- Method: MCFileRepositoryInspector>>initializeVersionNames (in category 'private') -----
+ initializeVersionNames
+ 	repository cacheAllFileNamesDuring:
+ 		[ super initializeVersionNames.
+ 		allVersionNames := repository readableFileNames ]!

Item was removed:
- ----- Method: MCFileRepositoryInspector>>load (in category 'actions') -----
- load
- 	self hasVersion ifTrue:
- 		[self version isCacheable
- 			ifTrue: [version workingCopy repositoryGroup addRepository: repository].
- 		super load.
- 		self refresh].!

Item was removed:
- ----- Method: MCFileRepositoryInspector>>merge (in category 'actions') -----
- merge
- 	super merge.
- 	self refresh.
- !

Item was removed:
- ----- Method: MCFileRepositoryInspector>>order: (in category 'morphic ui') -----
- order: anInteger
- 	self class order: (order := anInteger).
- 	self changed: #versionList.!

Item was removed:
- ----- 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 ].
- 	}!

Item was removed:
- ----- Method: MCFileRepositoryInspector>>orderString: (in category 'morphic ui') -----
- orderString: anIndex
- 	^String streamContents: [ :stream |
- 		order = anIndex
- 			ifTrue: [ stream nextPutAll: '<yes>' ]
- 			ifFalse: [ stream nextPutAll: '<no>' ].
- 		stream nextPutAll: (self orderSpecs at: anIndex) key ]!

Item was removed:
- ----- 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 ]!

Item was removed:
- ----- 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 ].
- 
- 	"sort loaded packages first, then alphabetically"
- 	loadedPackages := Set new: loaded size.
- 	loaded do: [ :each |
- 		loadedPackages add: (each packageName) ].
- 	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 removed:
- ----- Method: MCFileRepositoryInspector>>packageListMenu: (in category 'morphic ui') -----
- packageListMenu: aMenu
- 	^aMenu!

Item was removed:
- ----- Method: MCFileRepositoryInspector>>packageSelection (in category 'morphic ui') -----
- packageSelection
- 	^self packageList indexOf: selectedPackage!

Item was removed:
- ----- Method: MCFileRepositoryInspector>>packageSelection: (in category 'morphic ui') -----
- packageSelection: aNumber
- 	selectedPackage := aNumber isZero
- 		ifFalse: [ (self packageList at: aNumber) asString ].
- 	self versionSelection: 0.
- 	self changed: #packageSelection; changed: #versionList!

Item was removed:
- ----- Method: MCFileRepositoryInspector>>postAcceptBrowseFor: (in category 'private') -----
- postAcceptBrowseFor: aModel
- 	"Make the same selections as in aModel."
- 	self 
- 		packageSelection: aModel packageSelection ;
- 		versionSelection: aModel versionSelection!

Item was removed:
- ----- Method: MCFileRepositoryInspector>>refresh (in category 'actions') -----
- refresh
- 	packageList := nil.
- 	versions := repository readableFileNames collect: [ : each | MCFileName on: each ].
- 	self
- 		 refreshEmphasis ;
- 		 changed: #packageList ;
- 		 changed: #versionList!

Item was removed:
- ----- Method: MCFileRepositoryInspector>>repository (in category 'private') -----
- repository
- 	^ repository!

Item was removed:
- ----- Method: MCFileRepositoryInspector>>representsSameBrowseeAs: (in category 'morphic ui') -----
- representsSameBrowseeAs: anotherModel 
- 	^ self class = anotherModel class
- 	and: [ self repository = anotherModel repository ]!

Item was removed:
- ----- Method: MCFileRepositoryInspector>>setRepository:workingCopy: (in category 'initialize-release') -----
- 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 removed:
- ----- Method: MCFileRepositoryInspector>>version (in category 'morphic ui') -----
- version
- 	^ version ifNil:
- 		[Cursor wait showWhile:
- 			[version := repository versionFromFileNamed: selectedVersion].
- 		version]!

Item was removed:
- ----- Method: MCFileRepositoryInspector>>versionHighlight: (in category 'morphic ui') -----
- versionHighlight: aMCFileName
- 	inherited ifNil: [inherited := #()].
- 	^Text
- 		string: aMCFileName fileName
- 		attribute: (TextEmphasis new emphasisCode: (
- 			((loaded includes: aMCFileName) ifTrue: [ 4 "underlined" ]
- 				ifFalse: [ (inherited includes: aMCFileName versionName)
- 					ifTrue: [ 0 ]
- 					ifFalse: [ 1 "bold" ] ])))!

Item was changed:
+ ----- Method: MCFileRepositoryInspector>>versionInfo (in category 'private') -----
- ----- Method: MCFileRepositoryInspector>>versionInfo (in category 'morphic ui') -----
  versionInfo
  	^ versionInfo ifNil: [versionInfo := repository versionInfoFromFileNamed: selectedVersion]!

Item was removed:
- ----- 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 ]!

Item was removed:
- ----- Method: MCFileRepositoryInspector>>versionListMenu: (in category 'morphic ui') -----
- versionListMenu: aMenu
- 	1 to: self orderSpecs size do: [ :index |
- 		aMenu addUpdating: #orderString: target: self selector: #order: argumentList: { index } ].
- 	^aMenu!

Item was added:
+ ----- Method: MCFileRepositoryInspector>>versionNamesForNoPackageSelection (in category 'private') -----
+ versionNamesForNoPackageSelection
+ 	^ self allVersionNames!

Item was added:
+ ----- Method: MCFileRepositoryInspector>>versionNamesForSelectedPackage (in category 'private') -----
+ versionNamesForSelectedPackage
+ 	^ self allVersionNames select:
+ 		[ : each | each packageName = selectedPackage ]!

Item was removed:
- ----- Method: MCFileRepositoryInspector>>versionSelection (in category 'morphic ui') -----
- versionSelection
- 	^self versionList indexOf: selectedVersion!

Item was changed:
+ ----- Method: MCFileRepositoryInspector>>versionSelection: (in category 'private') -----
+ versionSelection: aNumber 
+ 	versionInfo := nil.
+ 	super versionSelection: aNumber!
- ----- Method: MCFileRepositoryInspector>>versionSelection: (in category 'morphic ui') -----
- versionSelection: aNumber
- 	aNumber isZero 
- 		ifTrue: [ selectedVersion := version := versionInfo := nil ]
- 		ifFalse: [ 
- 			selectedVersion := (self versionList at: aNumber) asString.
- 			version := versionInfo := nil].
- 	self changed: #versionSelection; changed: #summary; changed: #hasVersion!

Item was removed:
- ----- Method: MCFileRepositoryInspector>>widgetSpecs (in category 'morphic ui') -----
- widgetSpecs
- 	^#(	((buttonRow) (0 0 1 0) (0 0 0 30))
- 		((listMorph: package) (0 0 0.5 0.6) (0 30 0 0))
- 		((listMorph: version) (0.5 0 1 0.6) (0 30 0 0))
- 		((textMorph: summary) (0 0.6 1 1) (0 0 0 0)) )!

Item was changed:
  ----- Method: MCFtpRepository>>parseDirectoryListing: (in category 'as yet unclassified') -----
  parseDirectoryListing: aString
  	| stream files line tokens |
  	stream := aString readStream.
  	files := OrderedCollection new.
  	[stream atEnd] whileFalse:
  		[line := stream nextLine.
  		tokens := line findTokens: ' '.
+ 		tokens size > 2 ifTrue: [files add: tokens last asMCVersionName]].
- 		tokens size > 2 ifTrue: [files add: tokens last]].
  	^ files!

Item was changed:
  MCRepository subclass: #MCGOODSRepository
  	instanceVariableNames: 'hostname port connection'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Monticello-Repositories'!
+ 
+ !MCGOODSRepository commentStamp: 'cmm 3/6/2011 16:56' prior: 0!
+ A MCGOODSRepository simply stores a Dictionary of aVersionInfo-> aMCVersion.!

Item was added:
+ ----- Method: MCGOODSRepository>>allPackageNames (in category 'as yet unclassified') -----
+ allPackageNames
+ 	^ self root collect:
+ 		[ : ea | ea package name ]!

Item was added:
+ ----- Method: MCGOODSRepository>>includesVersionNamed: (in category 'as yet unclassified') -----
+ includesVersionNamed: aString 
+ 	^ (self versionNamed: aString) notNil!

Item was removed:
- ----- Method: MCGOODSRepository>>morphicOpen: (in category 'as yet unclassified') -----
- morphicOpen: aWorkingCopy
- 	(MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show!

Item was removed:
- ----- Method: MCGOODSRepository>>packages (in category 'as yet unclassified') -----
- packages
- 	^ (self root collect: [:ea | ea package]) asSet asSortedCollection!

Item was added:
+ ----- Method: MCGOODSRepository>>versionNamed: (in category 'as yet unclassified') -----
+ versionNamed: aString 
+ 	| versionName |
+ 	versionName := aString asMCVersionName.
+ 	self root keysDo:
+ 		[ : each | each versionName = versionName ifTrue: [ ^ each ] ].
+ 	^ nil!

Item was added:
+ ----- Method: MCGOODSRepository>>versionNamesForPackageNamed: (in category 'as yet unclassified') -----
+ versionNamesForPackageNamed: aString 
+ 	^ Array streamContents:
+ 		[ : stream | self root keysDo:
+ 			[ : each | each versionName packageName = aString ifTrue: [ stream nextPut: each ] ] ]!

Item was removed:
- ----- Method: MCGOODSRepository>>versionsAvailableForPackage: (in category 'as yet unclassified') -----
- versionsAvailableForPackage: aPackage
- 	^ self root asArray select: [:ea | ea package = aPackage] thenCollect: [:ea | ea info]!

Item was changed:
  ----- Method: MCHttpRepository>>parseFileNamesFromStream: (in category 'as yet unclassified') -----
  parseFileNamesFromStream: aStream
  	| names fullName |
  	names := OrderedCollection new.
  	[aStream atEnd] whileFalse:
  		[[aStream upTo: $<. {$a. $A. nil} includes: aStream next] whileFalse.
  		aStream upTo: $".
  		aStream atEnd ifFalse: [
  			fullName := aStream upTo: $".
+ 			names add: fullName unescapePercents asMCVersionName ]].
- 			names add: fullName unescapePercents]].
  	^ names!

Item was changed:
+ ----- Method: MCMethodDefinition class>>cachedDefinitions (in category 'accessing') -----
- ----- Method: MCMethodDefinition class>>cachedDefinitions (in category 'as yet unclassified') -----
  cachedDefinitions
  	
  	^definitions ifNil: [ definitions := WeakIdentityKeyDictionary new ]!

Item was changed:
+ ----- Method: MCMethodDefinition class>>className:classIsMeta:selector:category:timeStamp:source: (in category 'create') -----
- ----- Method: MCMethodDefinition class>>className:classIsMeta:selector:category:timeStamp:source: (in category 'as yet unclassified') -----
  className: classString
  classIsMeta: metaBoolean
  selector: selectorString
  category: catString
  timeStamp: timeString
  source: sourceString
  	^ self instanceLike:
  		(self new initializeWithClassName: classString
  					classIsMeta: metaBoolean
  					selector: selectorString
  					category: catString
  					timeStamp: timeString
  					source: sourceString)!

Item was changed:
+ ----- Method: MCMethodDefinition class>>className:selector:category:timeStamp:source: (in category 'create') -----
- ----- Method: MCMethodDefinition class>>className:selector:category:timeStamp:source: (in category 'as yet unclassified') -----
  className: classString
  selector: selectorString
  category: catString
  timeStamp: timeString
  source: sourceString
  	^ self	className: classString
  			classIsMeta: false
  			selector: selectorString
  			category: catString
  			timeStamp: timeString
  			source: sourceString!

Item was changed:
+ ----- Method: MCMethodDefinition class>>forMethodReference: (in category 'create') -----
- ----- Method: MCMethodDefinition class>>forMethodReference: (in category 'as yet unclassified') -----
  forMethodReference: aMethodReference
  	| definition |
  	definition := self cachedDefinitions at: aMethodReference compiledMethod ifAbsent: [].
  	(definition isNil
  		or: [definition selector ~= aMethodReference methodSymbol
  		or: [definition className ~= aMethodReference classSymbol
  		or: [definition classIsMeta ~= aMethodReference classIsMeta
  		or: [definition category ~= aMethodReference category]]]])
  			ifTrue: [definition := self 
  						className: aMethodReference classSymbol
  						classIsMeta: aMethodReference classIsMeta
  						selector: aMethodReference methodSymbol
  						category: aMethodReference category
  						timeStamp: aMethodReference timeStamp
  						source: aMethodReference source.
  					self cachedDefinitions at: aMethodReference compiledMethod put: definition].
  	^ definition
  	!

Item was changed:
+ ----- Method: MCMethodDefinition class>>initialize (in category 'class initialization') -----
- ----- Method: MCMethodDefinition class>>initialize (in category 'as yet unclassified') -----
  initialize
  	Smalltalk addToShutDownList: self!

Item was changed:
+ ----- Method: MCMethodDefinition class>>shutDown (in category 'class initialization') -----
- ----- Method: MCMethodDefinition class>>shutDown (in category 'as yet unclassified') -----
  shutDown
  	
  	definitions := nil.!

Item was changed:
  ----- Method: MCMethodDefinition>>addMethodAdditionTo: (in category 'installing') -----
+ addMethodAdditionTo: aCollection 
+ 	aCollection
+ 		 add: self asMethodAddition createCompiledMethod ;
+ 		 yourself!
- addMethodAdditionTo: aCollection
- 	| methodAddition |
- 	methodAddition := MethodAddition new
- 		compile: source
- 		classified: category
- 		withStamp: timeStamp
- 		notifying: nil
- 		logSource: true
- 		inClass: self actualClass.
- 	"This might raise an exception and never return"
- 	methodAddition createCompiledMethod.
- 	aCollection add: methodAddition.
- !

Item was changed:
+ ----- Method: MCMethodDefinition>>asMethodAddition (in category 'converting') -----
- ----- Method: MCMethodDefinition>>asMethodAddition (in category 'accessing') -----
  asMethodAddition
  	^MethodAddition new
  		compile: source
  		classified: category
  		withStamp: timeStamp
  		notifying: nil
  		logSource: true
  		inClass: self actualClass.!

Item was added:
+ ----- Method: MCMethodDefinition>>asMethodReference (in category 'converting') -----
+ asMethodReference
+ 	^ MethodReference
+ 		class: self actualClass
+ 		selector: self selector!

Item was added:
+ ----- Method: MCMethodDefinition>>workingCopy (in category 'accessing') -----
+ workingCopy
+ 	"Answer the working copy of which this object is defined."
+ 	^ self asMethodReference workingCopy!

Item was changed:
+ ----- Method: MCPackage>>= (in category 'testing') -----
- ----- Method: MCPackage>>= (in category 'as yet unclassified') -----
  = other
  	^ other species = self species and: [other name sameAs: name]!

Item was changed:
+ ----- Method: MCPackage>>hasWorkingCopy (in category 'testing') -----
- ----- Method: MCPackage>>hasWorkingCopy (in category 'as yet unclassified') -----
  hasWorkingCopy
  	^ MCWorkingCopy registry includesKey: self!

Item was changed:
+ ----- Method: MCPackage>>hash (in category 'testing') -----
- ----- Method: MCPackage>>hash (in category 'as yet unclassified') -----
  hash
  	^ name asLowercase hash!

Item was changed:
+ ----- Method: MCPackage>>name (in category 'accessing') -----
- ----- Method: MCPackage>>name (in category 'as yet unclassified') -----
  name
  	^ name!

Item was changed:
+ ----- Method: MCPackage>>name: (in category 'accessing') -----
- ----- Method: MCPackage>>name: (in category 'as yet unclassified') -----
  name: aString
  	name := aString!

Item was changed:
+ ----- Method: MCPackage>>printOn: (in category 'printing') -----
- ----- Method: MCPackage>>printOn: (in category 'as yet unclassified') -----
  printOn: aStream
  	super printOn: aStream.
  	aStream
  		nextPut: $(;
  		nextPutAll: name;
  		nextPut: $)!

Item was changed:
+ ----- Method: MCPackage>>snapshot (in category 'input/output') -----
- ----- Method: MCPackage>>snapshot (in category 'as yet unclassified') -----
  snapshot
  	| packageInfo definitions categories |
  	packageInfo := self packageInfo.
  	definitions := OrderedCollection new.
  	categories := packageInfo systemCategories.
  	categories isEmpty ifFalse: [ definitions add: (MCOrganizationDefinition categories: categories) ].
  	packageInfo methods do: [:ea | definitions add: ea asMethodDefinition] displayingProgress: 'Snapshotting methods...'.
  	(packageInfo respondsTo: #overriddenMethods) ifTrue:
  		[packageInfo overriddenMethods
  			do: [:ea | definitions add:
  					(packageInfo changeRecordForOverriddenMethod: ea) asMethodDefinition]
  			displayingProgress: 'Searching for overrides...'].
  	packageInfo classes do: [:ea | definitions addAll: ea classDefinitions] displayingProgress: 'Snapshotting classes...'.
  	(packageInfo respondsTo: #hasPreamble) ifTrue: [
  		packageInfo hasPreamble ifTrue: [definitions add: (MCPreambleDefinition from: packageInfo)].
  		packageInfo hasPostscript ifTrue: [definitions add: (MCPostscriptDefinition from: packageInfo)].
  		packageInfo hasPreambleOfRemoval ifTrue: [definitions add: (MCRemovalPreambleDefinition from: packageInfo)].
  		packageInfo hasPostscriptOfRemoval ifTrue: [definitions add: (MCRemovalPostscriptDefinition from: packageInfo)]]. 
  	^ MCSnapshot fromDefinitions: definitions
  !

Item was changed:
+ ----- Method: MCPackage>>storeOn: (in category 'input/output') -----
- ----- Method: MCPackage>>storeOn: (in category 'as yet unclassified') -----
  storeOn: aStream
  	aStream
  		nextPutAll: 'MCPackage';
  		space; nextPutAll: 'named: '; store: name.!

Item was changed:
+ ----- Method: MCPackage>>unload (in category 'input/output') -----
- ----- Method: MCPackage>>unload (in category 'as yet unclassified') -----
  unload
  	^ self workingCopy unload!

Item was changed:
+ ----- Method: MCPackage>>workingCopy (in category 'accessing') -----
- ----- Method: MCPackage>>workingCopy (in category 'as yet unclassified') -----
  workingCopy
  	^ MCWorkingCopy forPackage: self.!

Item was changed:
+ ----- Method: MCRepository class>>allConcreteSubclasses (in category 'configuring') -----
- ----- Method: MCRepository class>>allConcreteSubclasses (in category 'as yet unclassified') -----
  allConcreteSubclasses
  	^ self withAllSubclasses reject: [:ea | ea isAbstract]!

Item was changed:
+ ----- Method: MCRepository class>>creationTemplate (in category 'configuring') -----
- ----- Method: MCRepository class>>creationTemplate (in category 'as yet unclassified') -----
  creationTemplate
  	self subclassResponsibility.!

Item was changed:
+ ----- Method: MCRepository class>>description (in category 'configuring') -----
- ----- Method: MCRepository class>>description (in category 'as yet unclassified') -----
  description
  	^ nil!

Item was changed:
+ ----- Method: MCRepository class>>fillInTheBlankConfigure (in category 'configuring') -----
- ----- Method: MCRepository class>>fillInTheBlankConfigure (in category 'as yet unclassified') -----
  fillInTheBlankConfigure
  	^ self fillInTheBlankConfigure: self creationTemplate
  			!

Item was changed:
+ ----- Method: MCRepository class>>fillInTheBlankConfigure: (in category 'configuring') -----
- ----- Method: MCRepository class>>fillInTheBlankConfigure: (in category 'as yet unclassified') -----
  fillInTheBlankConfigure: aTemplateString
  	| chunk repo |
  	
  	aTemplateString ifNil: [ ^ false ].
  	chunk := FillInTheBlankMorph 
  			request: self fillInTheBlankRequest
  			initialAnswer: aTemplateString
  			centerAt: Sensor cursorPoint
  			inWorld: World
  			onCancelReturn: nil
  			acceptOnCR: false
  			answerExtent: 400 at 120.
  			
  	chunk 
  		ifNotNil: [ 
  			repo := self readFrom: chunk readStream.
  			repo creationTemplate: chunk. 
  	].
  
  	^ repo!

Item was changed:
+ ----- Method: MCRepository class>>fillInTheBlankRequest (in category 'configuring') -----
- ----- Method: MCRepository class>>fillInTheBlankRequest (in category 'as yet unclassified') -----
  fillInTheBlankRequest
  	self subclassResponsibility.!

Item was changed:
+ ----- Method: MCRepository class>>isAbstract (in category 'configuring') -----
- ----- Method: MCRepository class>>isAbstract (in category 'as yet unclassified') -----
  isAbstract
  	^ self description isNil!

Item was changed:
+ ----- Method: MCRepository class>>morphicConfigure (in category 'configuring') -----
- ----- Method: MCRepository class>>morphicConfigure (in category 'as yet unclassified') -----
  morphicConfigure
  	^ self new!

Item was removed:
- ----- Method: MCRepository class>>new (in category 'as yet unclassified') -----
- new
- 	^ self basicNew initialize!

Item was changed:
+ ----- Method: MCRepository>>= (in category 'testing') -----
- ----- Method: MCRepository>>= (in category 'as yet unclassified') -----
  = other
  	^ other species = self species and: [other description = self description]!

Item was added:
+ ----- Method: MCRepository>>allPackageNames (in category 'packages') -----
+ allPackageNames
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: MCRepository>>allVersionsDo: (in category 'versions') -----
+ allVersionsDo: aBlock
+ 	self allPackageNames asArray sort
+ 		do:
+ 			[ : eachPackageName | | sortedVersions |
+ 			sortedVersions := (self versionNamesForPackageNamed: eachPackageName) sort:
+ 				[ : a : b | a versionNumber < b versionNumber ].
+ 			sortedVersions
+ 				do:
+ 					[ : eachVersionName | (self versionNamed: eachVersionName) ifNotNil:
+ 						[ : ver | aBlock value: ver ] ]
+ 				displayingProgress:
+ 					[ : eachVersionName | 'Importing ' , eachVersionName ] ]
+ 		displayingProgress:
+ 			[ : eachPackageName | 'Importing versions of ' , eachPackageName ]!

Item was changed:
+ ----- Method: MCRepository>>alwaysStoreDiffs (in category 'accessing') -----
- ----- Method: MCRepository>>alwaysStoreDiffs (in category 'as yet unclassified') -----
  alwaysStoreDiffs
  	^ storeDiffs ifNil: [false]!

Item was changed:
+ ----- Method: MCRepository>>asCreationTemplate (in category 'accessing') -----
- ----- Method: MCRepository>>asCreationTemplate (in category 'as yet unclassified') -----
  asCreationTemplate
  	^ self creationTemplate!

Item was changed:
+ ----- Method: MCRepository>>basicStoreVersion: (in category 'private') -----
- ----- Method: MCRepository>>basicStoreVersion: (in category 'as yet unclassified') -----
  basicStoreVersion: aVersion
  	self subclassResponsibility!

Item was added:
+ ----- Method: MCRepository>>cacheAllFileNamesDuring: (in category 'private') -----
+ cacheAllFileNamesDuring: aBlock
+ 	"FileBasedRepository's can only access all version-names, therefore this is provided to allow client-code to direct caching of getting all filenames.  Other types of repositories offer more sophisticated kinds of access, so they don't need to cache, so simply run the block."
+ 	^ aBlock value!

Item was changed:
+ ----- Method: MCRepository>>closestAncestorVersionFor:ifNone: (in category 'accessing') -----
- ----- Method: MCRepository>>closestAncestorVersionFor:ifNone: (in category 'as yet unclassified') -----
  closestAncestorVersionFor: anAncestry ifNone: errorBlock
  	anAncestry breadthFirstAncestorsDo:
  		[:ancestorInfo |
  		(self versionWithInfo: ancestorInfo) ifNotNil: [:v | ^ v]].
  	^ errorBlock value!

Item was added:
+ ----- Method: MCRepository>>copyAllFrom: (in category 'versions') -----
+ copyAllFrom: aMCRepository 
+ 	"Copy all MCVersions from aMCRepository to the receiver."
+ 	aMCRepository allVersionsDo:
+ 		[ : eachVersion | self storeVersion: eachVersion ]!

Item was changed:
+ ----- Method: MCRepository>>creationTemplate (in category 'accessing') -----
- ----- Method: MCRepository>>creationTemplate (in category 'as yet unclassified') -----
  creationTemplate
  	^ creationTemplate!

Item was changed:
+ ----- Method: MCRepository>>creationTemplate: (in category 'accessing') -----
- ----- Method: MCRepository>>creationTemplate: (in category 'as yet unclassified') -----
  creationTemplate: aString
  	self creationTemplate ifNotNil: [ self error: 'Creation template already set for this MCRepository instance.' ].
  	
  	creationTemplate := aString.!

Item was changed:
+ ----- Method: MCRepository>>description (in category 'accessing') -----
- ----- Method: MCRepository>>description (in category 'as yet unclassified') -----
  description
  	^ self class name!

Item was changed:
+ ----- Method: MCRepository>>doAlwaysStoreDiffs (in category 'accessing') -----
- ----- Method: MCRepository>>doAlwaysStoreDiffs (in category 'as yet unclassified') -----
  doAlwaysStoreDiffs
  	storeDiffs := true!

Item was changed:
+ ----- Method: MCRepository>>doNotAlwaysStoreDiffs (in category 'accessing') -----
- ----- Method: MCRepository>>doNotAlwaysStoreDiffs (in category 'as yet unclassified') -----
  doNotAlwaysStoreDiffs
  	storeDiffs := false!

Item was changed:
+ ----- Method: MCRepository>>hash (in category 'testing') -----
- ----- Method: MCRepository>>hash (in category 'as yet unclassified') -----
  hash
  	^ self description hash!

Item was added:
+ ----- Method: MCRepository>>highestNumberedVersionNameForPackageNamed: (in category 'versions') -----
+ highestNumberedVersionNameForPackageNamed: aString 
+ 	^ (self versionNamesForPackageNamed: aString)
+ 		ifNil: [ self error: aString , ' not found in ' , self asString ]
+ 		ifNotNilDo:
+ 			[ : pkg | pkg detectMax:
+ 				[ : each | each versionNumber ] ]!

Item was changed:
+ ----- Method: MCRepository>>includesVersionNamed: (in category 'versions') -----
- ----- Method: MCRepository>>includesVersionNamed: (in category 'interface') -----
  includesVersionNamed: aString
  	self subclassResponsibility!

Item was removed:
- ----- Method: MCRepository>>initialize (in category 'as yet unclassified') -----
- initialize!

Item was changed:
+ ----- Method: MCRepository>>morphicOpen (in category 'ui') -----
- ----- Method: MCRepository>>morphicOpen (in category 'interface') -----
  morphicOpen
  	self morphicOpen: nil!

Item was changed:
+ ----- Method: MCRepository>>morphicOpen: (in category 'ui') -----
- ----- Method: MCRepository>>morphicOpen: (in category 'interface') -----
  morphicOpen: aWorkingCopy
+ 	(MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show!
- 	self subclassResponsibility !

Item was changed:
+ ----- Method: MCRepository>>notificationForVersion: (in category 'accessing') -----
- ----- Method: MCRepository>>notificationForVersion: (in category 'as yet unclassified') -----
  notificationForVersion: aVersion
  	^ MCVersionNotification version: aVersion repository: self!

Item was changed:
+ ----- Method: MCRepository>>notifyList (in category 'accessing') -----
- ----- Method: MCRepository>>notifyList (in category 'as yet unclassified') -----
  notifyList
  	^ #()!

Item was changed:
+ ----- Method: MCRepository>>openAndEditTemplateCopy (in category 'ui') -----
- ----- Method: MCRepository>>openAndEditTemplateCopy (in category 'interface') -----
  openAndEditTemplateCopy
  	^ self class fillInTheBlankConfigure: (self asCreationTemplate ifNil: [^nil])!

Item was changed:
+ ----- Method: MCRepository>>possiblyNewerVersionsOfAnyOf: (in category 'versions') -----
+ possiblyNewerVersionsOfAnyOf: versionNames 
+ 	"Answer a collection of MCVersionNames which might be newer versions of the versions identified by versionNames."
+ 	^ versionNames
+ 		inject: OrderedCollection new
+ 		into:
+ 			[ : coll : eachVersionName | | eachPackageName |
+ 			eachPackageName := eachVersionName packageName.
+ 			(self versionNamesForPackageNamed: eachPackageName) do:
+ 				[ : eachInSelf | (eachInSelf versionNumber > eachVersionName versionNumber or:
+ 					[ eachInSelf versionNumber = eachVersionName versionNumber and: [ eachInSelf author ~= eachVersionName author ] ]) ifTrue: [ coll add: eachInSelf ] ].
+ 			coll ]!
- ----- Method: MCRepository>>possiblyNewerVersionsOfAnyOf: (in category 'as yet unclassified') -----
- possiblyNewerVersionsOfAnyOf: someVersions
- 	^#()!

Item was changed:
+ ----- Method: MCRepository>>prepareVersionForStorage: (in category 'accessing') -----
- ----- Method: MCRepository>>prepareVersionForStorage: (in category 'as yet unclassified') -----
  prepareVersionForStorage: aVersion
  	^ self alwaysStoreDiffs
  		ifTrue: [aVersion asDiffAgainst:
  				 (self closestAncestorVersionFor: aVersion info ifNone: [^ aVersion])]
  		ifFalse: [aVersion]!

Item was changed:
+ ----- Method: MCRepository>>printOn: (in category 'printing') -----
- ----- Method: MCRepository>>printOn: (in category 'as yet unclassified') -----
  printOn: aStream
  	super printOn: aStream.
  	aStream
  		nextPut: $(;
  		nextPutAll: self description;
  		nextPut: $).!

Item was added:
+ ----- Method: MCRepository>>refresh (in category 'accessing') -----
+ refresh
+ 	"Subclasses override if necessary."!

Item was changed:
+ ----- Method: MCRepository>>sendNotificationsForVersion: (in category 'accessing') -----
- ----- Method: MCRepository>>sendNotificationsForVersion: (in category 'as yet unclassified') -----
  sendNotificationsForVersion: aVersion
  	| notification notifyList |
  	notifyList := self notifyList.
  	notifyList isEmpty ifFalse:
  		[notification := self notificationForVersion: aVersion.
  		notifyList do: [:ea | notification notify: ea]]!

Item was changed:
+ ----- Method: MCRepository>>storeVersion: (in category 'accessing') -----
- ----- Method: MCRepository>>storeVersion: (in category 'as yet unclassified') -----
  storeVersion: aVersion
  	self basicStoreVersion: (self prepareVersionForStorage: aVersion).
  	self sendNotificationsForVersion: aVersion!

Item was changed:
  ----- Method: MCRepository>>versionNamed: (in category 'versions') -----
+ versionNamed: aMCVersionName
+ 	"Answer the MCVersion with name, aMCVersionName, or nil if it doesn't exist in this repository."
+ 	self subclassResponsibility!
- versionNamed: versionName
- 	"Answer the MCVersion corresponding to the given version name"
- 
- 	^self versionNamed: versionName ifAbsent:[nil]!

Item was removed:
- ----- Method: MCRepository>>versionNamed:ifAbsent: (in category 'versions') -----
- versionNamed: versionName ifAbsent: aBlock
- 	"Answer the MCVersion corresponding to the given version name"
- 
- 	^aBlock value!

Item was added:
+ ----- Method: MCRepository>>versionNamesForPackageNamed: (in category 'versions') -----
+ versionNamesForPackageNamed: aString
+ 	"Answer a collection of MCVersionNames whose Package is named aString."
+ 	self subclassResponsibility!

Item was changed:
+ ----- Method: MCRepository>>versionWithInfo: (in category 'versions') -----
- ----- Method: MCRepository>>versionWithInfo: (in category 'interface') -----
  versionWithInfo: aVersionInfo
  	^ self versionWithInfo: aVersionInfo ifAbsent: [nil]!

Item was changed:
+ ----- Method: MCRepository>>versionWithInfo:ifAbsent: (in category 'versions') -----
- ----- Method: MCRepository>>versionWithInfo:ifAbsent: (in category 'interface') -----
  versionWithInfo: aVersionInfo ifAbsent: aBlock
  	self subclassResponsibility !

Item was added:
+ ----- Method: MCRepositoryGroup class>>flushAllCaches (in category 'as yet unclassified') -----
+ flushAllCaches
+ 	self default repositoriesDo:
+ 		[ : each | each flushCache ]!

Item was changed:
+ ----- Method: MCRepositoryGroup>>addRepository: (in category 'add / remove') -----
- ----- Method: MCRepositoryGroup>>addRepository: (in category 'as yet unclassified') -----
  addRepository: aRepository
  	((repositories includes: aRepository) or: [aRepository == MCCacheRepository default])
  		ifFalse: [repositories add: aRepository.
  				self class default addRepository: aRepository].
  	self changed: #repositories!

Item was changed:
+ ----- Method: MCRepositoryGroup>>includes: (in category 'testing') -----
- ----- Method: MCRepositoryGroup>>includes: (in category 'as yet unclassified') -----
  includes: aRepository
  	^ self repositories includes: aRepository!

Item was changed:
+ ----- Method: MCRepositoryGroup>>includesVersionNamed: (in category 'testing') -----
+ includesVersionNamed: aString 
+ 	| versionName |
+ 	versionName := aString asMCVersionName.
+ 	self repositoriesDo:
+ 		[ : ea | (ea includesVersionNamed: versionName) ifTrue: [ ^ true ] ].
+ 	^ false!
- ----- Method: MCRepositoryGroup>>includesVersionNamed: (in category 'as yet unclassified') -----
- includesVersionNamed: aString
- 	self repositoriesDo: [:ea | (ea includesVersionNamed: aString) ifTrue: [^ true]].
- 	^ false	!

Item was changed:
+ ----- Method: MCRepositoryGroup>>initialize (in category 'initialize-release') -----
- ----- Method: MCRepositoryGroup>>initialize (in category 'as yet unclassified') -----
  initialize
  	repositories := OrderedCollection new!

Item was changed:
+ ----- Method: MCRepositoryGroup>>removeRepository: (in category 'add / remove') -----
- ----- Method: MCRepositoryGroup>>removeRepository: (in category 'as yet unclassified') -----
  removeRepository: aRepository
  	repositories remove: aRepository ifAbsent: [].
  	self changed: #repositories!

Item was changed:
+ ----- Method: MCRepositoryGroup>>repositories (in category 'accessing') -----
- ----- Method: MCRepositoryGroup>>repositories (in category 'as yet unclassified') -----
  repositories
  	^ ((Array with: MCCacheRepository default), repositories) select: [ :ea | ea isValid ]!

Item was changed:
+ ----- Method: MCRepositoryGroup>>repositoriesDo: (in category 'accessing') -----
- ----- Method: MCRepositoryGroup>>repositoriesDo: (in category 'as yet unclassified') -----
  repositoriesDo: aBlock
  	self repositories do: [:ea | [aBlock value: ea] on: Error do: []]!

Item was changed:
+ ----- Method: MCRepositoryGroup>>versionWithInfo: (in category 'accessing') -----
- ----- Method: MCRepositoryGroup>>versionWithInfo: (in category 'as yet unclassified') -----
  versionWithInfo: aVersionInfo
  	^self versionWithInfo: aVersionInfo ifNone: [ nil ]
  !

Item was changed:
+ ----- Method: MCRepositoryGroup>>versionWithInfo:ifNone: (in category 'accessing') -----
- ----- Method: MCRepositoryGroup>>versionWithInfo:ifNone: (in category 'as yet unclassified') -----
  versionWithInfo: aVersionInfo ifNone: aBlock
  	self repositoriesDo: [:ea | (ea versionWithInfo: aVersionInfo) ifNotNil: [:v | ^ v]].
  	^aBlock value!

Item was changed:
  MCVersionInspector subclass: #MCRepositoryInspector
+ 	instanceVariableNames: 'repository packageNames versionNames selectedPackage selectedVersion order versionInfo loaded newer inherited'
+ 	classVariableNames: 'Order'
- 	instanceVariableNames: 'repository packages versions selectedPackage selectedVersion'
- 	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Monticello-UI'!

Item was added:
+ ----- Method: MCRepositoryInspector class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"self initialize"
+ 
+ 	self migrateInstances!

Item was added:
+ ----- Method: MCRepositoryInspector class>>migrateInstances (in category 'class initialization') -----
+ migrateInstances
+ 	self allSubInstancesDo: [:inst |
+ 		#(packageList versionList) do: [:each |
+ 			[(inst findListMorph: each) highlightSelector: nil]
+ 				on: Error do: [:ignore | ]]].!

Item was added:
+ ----- Method: MCRepositoryInspector class>>order (in category 'as yet unclassified') -----
+ order
+ 	Order isNil
+ 		ifTrue: [ Order := 5 ].
+ 	^Order!

Item was added:
+ ----- Method: MCRepositoryInspector class>>order: (in category 'as yet unclassified') -----
+ order: anInteger
+ 	Order := anInteger!

Item was changed:
  ----- Method: MCRepositoryInspector class>>repository:workingCopy: (in category 'as yet unclassified') -----
  repository: aFileBasedRepository workingCopy: aWorkingCopy
  	^self new
  		setRepository: aFileBasedRepository workingCopy: aWorkingCopy;
  		yourself!

Item was changed:
  ----- Method: MCRepositoryInspector>>defaultExtent (in category 'morphic ui') -----
  defaultExtent
  	^450 at 300!

Item was changed:
  ----- Method: MCRepositoryInspector>>defaultLabel (in category 'morphic ui') -----
  defaultLabel
  	^'Repository: ' , repository description!

Item was changed:
  ----- Method: MCRepositoryInspector>>hasVersion (in category 'morphic ui') -----
  hasVersion
  	^ selectedVersion notNil!

Item was added:
+ ----- Method: MCRepositoryInspector>>identifyLoadedAndInherited: (in category 'morphic ui') -----
+ identifyLoadedAndInherited: aMCWorkingCopy 
+ 	aMCWorkingCopy ancestors do:
+ 		[ : ancestor | loaded add: ancestor versionName.
+ 		ancestor ancestorsDoWhileTrue:
+ 			[ : heir | (inherited includes: heir name)
+ 				ifTrue: [ false ]
+ 				ifFalse:
+ 					[ inherited add: heir name asMCVersionName.
+ 					true ] ] ]!

Item was added:
+ ----- Method: MCRepositoryInspector>>identifyNewerVersionsOf: (in category 'initialize-release') -----
+ identifyNewerVersionsOf: aMCWorkingCopy 
+ 	(repository possiblyNewerVersionsOfAnyOf: aMCWorkingCopy ancestry names) do:
+ 		[ : eachNewerVersionName | newer add: eachNewerVersionName packageName ]!

Item was added:
+ ----- Method: MCRepositoryInspector>>initialize (in category 'initialize-release') -----
+ initialize
+ 	super initialize.
+ 	self initializeEmphasis!

Item was added:
+ ----- Method: MCRepositoryInspector>>initializeEmphasis (in category 'initialize-release') -----
+ initializeEmphasis
+ 	inherited := Set new.
+ 	loaded := Set new!

Item was added:
+ ----- Method: MCRepositoryInspector>>initializeVersionNames (in category 'initialize-release') -----
+ initializeVersionNames
+ 	repository cacheAllFileNamesDuring:
+ 		[ versionNames := repository versionNamesForPackageNamed: selectedPackage.
+ 		self refreshEmphasis ]!

Item was changed:
+ ----- Method: MCRepositoryInspector>>load (in category 'actions') -----
- ----- Method: MCRepositoryInspector>>load (in category 'accessing') -----
  load
  	self hasVersion ifTrue:
+ 		[self version isCacheable
+ 			ifTrue: [version workingCopy repositoryGroup addRepository: repository].
+ 		super load.
+ 		self refresh].!
- 		[super load.
- 		self version workingCopy repositoryGroup addRepository: repository].!

Item was added:
+ ----- Method: MCRepositoryInspector>>merge (in category 'actions') -----
+ merge
+ 	super merge.
+ 	self refresh.
+ !

Item was added:
+ ----- Method: MCRepositoryInspector>>order: (in category 'morphic ui') -----
+ order: anInteger
+ 	self class order: (order := anInteger).
+ 	self changed: #versionList.!

Item was added:
+ ----- Method: MCRepositoryInspector>>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 ].
+ 	}!

Item was added:
+ ----- Method: MCRepositoryInspector>>orderString: (in category 'morphic ui') -----
+ orderString: anIndex
+ 	^String streamContents: [ :stream |
+ 		order = anIndex
+ 			ifTrue: [ stream nextPutAll: '<yes>' ]
+ 			ifFalse: [ stream nextPutAll: '<no>' ].
+ 		stream nextPutAll: (self orderSpecs at: anIndex) key ]!

Item was added:
+ ----- Method: MCRepositoryInspector>>packageHighlight: (in category 'morphic ui') -----
+ packageHighlight: aString 
+ 	^ (loaded anySatisfy:
+ 		[ : each | each packageName = aString ])
+ 		ifTrue:
+ 			[ Text
+ 				string: aString
+ 				attribute:
+ 					(TextEmphasis new emphasisCode:
+ 						((newer includes: aString)
+ 							ifTrue: [ 5 ]
+ 							ifFalse: [ 4 ])) ]
+ 		ifFalse: [ aString ]!

Item was changed:
  ----- Method: MCRepositoryInspector>>packageList (in category 'morphic ui') -----
  packageList
+ 	| result loadedPackages |
+ 	packageNames ifNotNil: [ ^ packageNames ].
+ 	"Enjoy emphasis side-effects of populating my versionNames." 
+ 	self versionNames.
+ 	result := repository allPackageNames.
+ 	"sort loaded packages first, then alphabetically"
+ 	loadedPackages := Set new: loaded size.
+ 	loaded do:
+ 		[ : each | loadedPackages add: each packageName ].
+ 	result := result asArray sort:
+ 		[ : a : b | | loadedA loadedB |
+ 		loadedA := loadedPackages includes: a.
+ 		loadedB := loadedPackages includes: b.
+ 		loadedA = loadedB
+ 			ifTrue: [ a < b ]
+ 			ifFalse: [ loadedA ] ].
+ 	^ packageNames := result collect:
+ 		[ : each | self packageHighlight: each ]!
- 	^ packages collect: [:ea | ea name]!

Item was changed:
  ----- Method: MCRepositoryInspector>>packageListMenu: (in category 'morphic ui') -----
  packageListMenu: aMenu
  	^aMenu!

Item was changed:
  ----- Method: MCRepositoryInspector>>packageSelection (in category 'morphic ui') -----
  packageSelection
+ 	^self packageList indexOf: selectedPackage!
- 	^ packages indexOf: selectedPackage!

Item was changed:
  ----- Method: MCRepositoryInspector>>packageSelection: (in category 'morphic ui') -----
  packageSelection: aNumber
+ 	selectedPackage := aNumber isZero
+ 		ifFalse: [ (self packageList at: aNumber) asString ].
+ 	self versionSelection: 0.
+ 	versionNames := nil.
- 	selectedPackage := aNumber isZero ifFalse: [ packages at: aNumber ].
- 	versions := repository versionsAvailableForPackage: selectedPackage.
  	self changed: #packageSelection; changed: #versionList!

Item was changed:
+ ----- Method: MCRepositoryInspector>>postAcceptBrowseFor: (in category 'initialize-release') -----
- ----- Method: MCRepositoryInspector>>postAcceptBrowseFor: (in category 'private') -----
  postAcceptBrowseFor: aModel
  	"Make the same selections as in aModel."
  	self 
  		packageSelection: aModel packageSelection ;
  		versionSelection: aModel versionSelection!

Item was changed:
+ ----- Method: MCRepositoryInspector>>refresh (in category 'actions') -----
- ----- Method: MCRepositoryInspector>>refresh (in category 'accessing') -----
  refresh
+ 	packageNames := versionNames := newer := nil.
+ 	repository refresh.
+ 	self
+ 		 changed: #packageList ;
+ 		 changed: #versionList.!
- 	packages := repository packages.
- 	self changed: #packageList.
- 	self packageSelection: self packageSelection.
- !

Item was added:
+ ----- Method: MCRepositoryInspector>>refreshEmphasis (in category 'morphic ui') -----
+ refreshEmphasis
+ 	| identifyNewer |
+ 	identifyNewer := newer isNil.
+ 	identifyNewer ifTrue: [ newer := Set new ].
+ 	self initializeEmphasis.
+ 	MCWorkingCopy allManagers do:
+ 		[ : each | self identifyLoadedAndInherited: each.
+ 		identifyNewer ifTrue: [ self identifyNewerVersionsOf: each ] ]!

Item was changed:
+ ----- Method: MCRepositoryInspector>>repository (in category 'access') -----
- ----- Method: MCRepositoryInspector>>repository (in category 'private') -----
  repository
  	^ repository!

Item was changed:
+ ----- Method: MCRepositoryInspector>>representsSameBrowseeAs: (in category 'morphic ui') -----
- ----- Method: MCRepositoryInspector>>representsSameBrowseeAs: (in category 'private') -----
  representsSameBrowseeAs: anotherModel 
  	^ self class = anotherModel class
  	and: [ self repository = anotherModel repository ]!

Item was changed:
  ----- Method: MCRepositoryInspector>>setRepository:workingCopy: (in category 'initialize-release') -----
+ setRepository: aFileBasedRepository workingCopy: aWorkingCopy 
+ 	order := self class order.
+ 	repository := aFileBasedRepository.
+ 	self refresh.
+ 	aWorkingCopy
+ 		ifNil: [ self packageSelection: 1 ]
+ 		ifNotNil:
+ 			[ selectedPackage := aWorkingCopy ancestry ancestors ifNotEmpty:
+ 				[ : ancestors | ancestors anyOne name asMCVersionName packageName ] ].
+ 	MCWorkingCopy addDependent: self!
- setRepository: aRepository workingCopy: aWorkingCopy
- 	repository := aRepository.
- 	aWorkingCopy isNil ifFalse: [ selectedPackage := aWorkingCopy package].
- 	self refresh!

Item was removed:
- ----- Method: MCRepositoryInspector>>sortedVersions (in category 'morphic ui') -----
- sortedVersions
- 	| sorter |
- 	sorter := MCVersionSorter new.
- 	sorter addAllVersionInfos: versions.
- 	^ sorter sortedVersionInfos select: [:ea | versions includes: ea]!

Item was removed:
- ----- Method: MCRepositoryInspector>>summary (in category 'accessing') -----
- summary
- 	^ selectedVersion
- 		ifNotNil: [selectedVersion summary]
- 		ifNil: ['']!

Item was changed:
+ ----- Method: MCRepositoryInspector>>version (in category 'morphic ui') -----
- ----- Method: MCRepositoryInspector>>version (in category 'accessing') -----
  version
+ 	^ version ifNil:
+ 		[Cursor wait showWhile:
+ 			[version := repository versionNamed: selectedVersion].
+ 		version]!
- 	^ version ifNil: [version := repository versionWithInfo: selectedVersion]!

Item was added:
+ ----- Method: MCRepositoryInspector>>versionHighlight: (in category 'morphic ui') -----
+ versionHighlight: aMCVersionName
+ 	inherited ifNil: [inherited := #()].
+ 	^Text
+ 		string: aMCVersionName
+ 		attribute: (TextEmphasis new emphasisCode: (
+ 			((loaded includes: aMCVersionName) ifTrue: [ 4 "underlined" ]
+ 				ifFalse: [ (inherited includes: aMCVersionName)
+ 					ifTrue: [ 0 ]
+ 					ifFalse: [ 1 "bold" ] ])))!

Item was changed:
  ----- Method: MCRepositoryInspector>>versionList (in category 'morphic ui') -----
  versionList
+ 	| result |
+ 	result := selectedPackage
+ 		ifNil: [ self versionNamesForNoPackageSelection ]
+ 		ifNotNil: [ self versionNamesForSelectedPackage ].
+ 	"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 collect:
+ 		[ : each | self versionHighlight: each ]!
- 	^ self sortedVersions collect: [:ea | ea name]!

Item was changed:
  ----- Method: MCRepositoryInspector>>versionListMenu: (in category 'morphic ui') -----
  versionListMenu: aMenu
+ 	1 to: self orderSpecs size do: [ :index |
+ 		aMenu addUpdating: #orderString: target: self selector: #order: argumentList: { index } ].
  	^aMenu!

Item was added:
+ ----- Method: MCRepositoryInspector>>versionNames (in category 'access') -----
+ versionNames
+ 	^ versionNames ifNil:
+ 		[ self initializeVersionNames.
+ 		versionNames ]!

Item was added:
+ ----- Method: MCRepositoryInspector>>versionNamesForNoPackageSelection (in category 'access') -----
+ versionNamesForNoPackageSelection
+ 	^ Array empty!

Item was added:
+ ----- Method: MCRepositoryInspector>>versionNamesForSelectedPackage (in category 'morphic ui') -----
+ versionNamesForSelectedPackage
+ 	^ self versionNames!

Item was changed:
  ----- Method: MCRepositoryInspector>>versionSelection (in category 'morphic ui') -----
  versionSelection
+ 	^self versionList indexOf: selectedVersion!
- 	^ versions indexOf: selectedVersion!

Item was changed:
  ----- Method: MCRepositoryInspector>>versionSelection: (in category 'morphic ui') -----
+ versionSelection: aNumber 
+ 	selectedVersion := version := nil.
+ 	aNumber isZero ifFalse: [ selectedVersion := (self versionList at: aNumber) asString ].
+ 	self
+ 		 changed: #versionSelection ;
+ 		 changed: #summary ;
+ 		 changed: #hasVersion!
- versionSelection: aNumber
- 	aNumber isZero 
- 		ifTrue: [ selectedVersion := nil ]
- 		ifFalse: [ 
- 			selectedVersion := versions at: aNumber].
- 	self changed: #versionSelection; changed: #summary!

Item was changed:
  ----- Method: MCRepositoryInspector>>widgetSpecs (in category 'morphic ui') -----
  widgetSpecs
  	^#(	((buttonRow) (0 0 1 0) (0 0 0 30))
  		((listMorph: package) (0 0 0.5 0.6) (0 30 0 0))
  		((listMorph: version) (0.5 0 1 0.6) (0 30 0 0))
  		((textMorph: summary) (0 0.6 1 1) (0 0 0 0)) )!

Item was removed:
- ----- Method: MCSMCacheRepository>>allFileNames (in category 'accessing') -----
- allFileNames
- 	^self allFullFileNames collect: [ :ea | self directory localNameFor: ea ]!

Item was changed:
  ----- Method: MCSMReleaseRepository>>releaseVersion:url: (in category 'as yet unclassified') -----
  releaseVersion: aVersion url: urlString
  	| result |
  	result := HTTPSocket
  		httpPost: self squeakMapUrl, '/packagebyname/', packageName, '/newrelease'
+ 		args: {'version' -> {(aVersion info versionNumber)}.
- 		args: {'version' -> {(aVersion info name copyAfter: $.) extractNumber asString}.
  			   'note' -> {aVersion info message}.
  			   'downloadURL' -> {urlString}}
  		user: user
  		passwd: password.
  	result contents size > 4 ifTrue: [self error: result contents]
  !

Item was changed:
  ----- Method: MCVersion>>fileName (in category 'accessing') -----
  fileName
+ 	^ (info name, '.', self writerClass extension) asMCVersionName!
- 	^ info name, '.', self writerClass extension!

Item was added:
+ ----- Method: MCVersionInfo>>dateAndTime (in category 'accessing') -----
+ dateAndTime
+ 	^ DateAndTime
+ 		date: date
+ 		time: (time ifNil: [ Time midnight ])!

Item was changed:
  ----- Method: MCVersionInfo>>initializeWithName:id:message:date:time:author:ancestors:stepChildren: (in category 'initialize-release') -----
  initializeWithName: vName id: aUUID message: aString date: aDate time: aTime author: initials ancestors: aCollection stepChildren: stepCollection
+ 	name := vName asString asMCVersionName.
- 	name := vName.
  	id := aUUID.
  	message := aString.
  	date := aDate.
  	time := aTime.
  	author := initials.
  	ancestors :=  aCollection.
  	stepChildren := stepCollection!

Item was removed:
- ----- Method: MCVersionInfo>>mcName (in category 'accessing') -----
- mcName
- 	^ MCFileName on: self name!

Item was added:
+ ----- Method: MCVersionInfo>>versionName (in category 'accessing') -----
+ versionName
+ 	^ name
+ 		ifNil: [ self name ]
+ 		ifNotNil: [ name asMCVersionName ]!

Item was added:
+ ----- Method: MCVersionInfo>>versionNumber (in category 'accessing') -----
+ versionNumber
+ 	^ self versionName versionNumber!

Item was changed:
  MCTool subclass: #MCVersionInspector
+ 	instanceVariableNames: 'version'
- 	instanceVariableNames: 'version loaded newer inherited'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Monticello-UI'!

Item was removed:
- ----- 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 removed:
- ----- 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 added:
+ ByteString variableByteSubclass: #MCVersionName
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Monticello-Modeling'!
+ 
+ !MCVersionName commentStamp: 'cmm 3/4/2011 13:32' prior: 0!
+ A MCVersionName models the Monticello file / version name, in the format [Package]-[Author].[version-number]([ancestorAuthor.ancestorVersionNumber]).[mc?].
+ 
+ Any file-extension, if present, is ignored.!

Item was added:
+ ----- Method: MCVersionName classSide>>on: (in category 'create') -----
+ on: aString 
+ 	"aString may be with or without a mc? extension."
+ 	^ (self new: aString size)
+ 		replaceFrom: 1
+ 			to: aString size
+ 			with: aString
+ 			startingAt: 1 ;
+ 		yourself!

Item was added:
+ ----- Method: MCVersionName>>= (in category 'testing') -----
+ = aByteString 
+ 	"Ignore any file-extension for comparison of MCVersionNames."
+ 	| myVersionName |
+ 	aByteString isString ifFalse: [ ^ false ].
+ 	myVersionName := self versionName.
+ 	^ (myVersionName
+ 		compare: myVersionName
+ 		with: aByteString asMCVersionName versionName
+ 		collated: AsciiOrder) = 2!

Item was added:
+ ----- Method: MCVersionName>>ancestorAuthor (in category 'access') -----
+ ancestorAuthor
+ 	"The author of the ancestor, if this is a Diffy filename."
+ 	^ self ancestry in:
+ 		[ : authorDotVersion | authorDotVersion copyUpTo: $. ]!

Item was added:
+ ----- Method: MCVersionName>>ancestorVersionNumber (in category 'access') -----
+ ancestorVersionNumber
+ 	"The author of the ancestor, if this is a Diffy filename."
+ 	^ self ancestry in:
+ 		[ : authorDotVersion | (authorDotVersion copyAfter: $.) asInteger ifNil: [ 0 ] ]!

Item was added:
+ ----- Method: MCVersionName>>ancestry (in category 'private') -----
+ ancestry
+ 	"If I am a in the diffy-format which includes the ancestor attributes, answer them as a single String, separated by a dot."
+ 	^ (self copyAfterLast: $() copyUpTo: $)!

Item was added:
+ ----- Method: MCVersionName>>asMCVersionName (in category 'converting') -----
+ asMCVersionName
+ 	^ self!

Item was added:
+ ----- Method: MCVersionName>>author (in category 'access') -----
+ author
+ 	"The author initials embedded in the filename."
+ 	^ self versionName in:
+ 		[ : verName | (verName copyAfterLast: $-) copyUpTo: $. ]!

Item was added:
+ ----- Method: MCVersionName>>hash (in category 'testing') -----
+ hash
+ 	^ self versionName hash!

Item was added:
+ ----- Method: MCVersionName>>isValid (in category 'testing') -----
+ isValid
+ 	^ [ self packageName notEmpty and:
+ 		[ self author notEmpty and: [ self versionNumber > 0 ] ] ]
+ 		on: Error
+ 		do:
+ 			[ : err | false ]!

Item was added:
+ ----- Method: MCVersionName>>packageName (in category 'access') -----
+ packageName
+ 	"The MC Package name embedded into this filename."
+ 	^ self versionName in:
+ 		[ : verName | verName copyUpToLast: $- ]!

Item was added:
+ ----- Method: MCVersionName>>species (in category 'private') -----
+ species
+ 	^ ByteString!

Item was added:
+ ----- Method: MCVersionName>>versionName (in category 'access') -----
+ versionName
+ 	"Answer my version name as a ByteString, without the file suffix or any ancestor-attributes."
+ 	^ self last isDigit
+ 		ifTrue:
+ 			[ "The whole of me, but convert to a ByteString"
+ 			self
+ 				copyFrom: 1
+ 				to: self size ]
+ 		ifFalse: [ (self copyUpToLast: $.) copyUpTo: $( ]!

Item was added:
+ ----- Method: MCVersionName>>versionNumber (in category 'access') -----
+ versionNumber
+ 	"The Integer version number identified by this filename."
+ 	^ ((self versionName copyAfterLast: $-) copyAfter: $.) asInteger ifNil: [ 0 ]!

Item was changed:
  ----- Method: MCWorkingCopy>>nextVersionName (in category 'private') -----
  nextVersionName
  	| branch oldName |
  	ancestry ancestors isEmpty
+ 		ifTrue:
+ 			[ counter ifNil: [ counter := 0 ].
+ 			branch := package name ]
- 		ifTrue: [counter ifNil: [counter := 0]. branch := package name]
  		ifFalse:
+ 			[ oldName := ancestry ancestors first versionName.
+ 			branch := oldName packageName.
+ 			counter ifNil:
+ 				[ counter := (ancestry ancestors detectMax:
+ 					[ : eachVersionInfo | eachVersionInfo versionNumber ])
+ 					ifNil: [ 0 ]
+ 					ifNotNil:
+ 						[ : highestNumbered | highestNumbered versionNumber ] ] ].
- 			[oldName := ancestry ancestors first name.
- 			oldName last isDigit
- 				ifFalse: [branch := oldName]
- 				ifTrue: [branch := oldName copyUpToLast: $-].
- 			counter ifNil: [
- 				counter := (ancestry ancestors collect: [:each |
- 					each name last isDigit
- 						ifFalse: [0]
- 						ifTrue: [(each name copyAfterLast: $-) extractNumber]]) max]].
- 
  	counter := counter + 1.
+ 	^ branch , '-' , Utilities authorInitials , '.' , counter asString!
- 	^ branch, '-',  Utilities authorInitials, '.', counter asString!

Item was changed:
  ----- Method: MCWorkingCopy>>possiblyNewerVersionsIn: (in category 'private') -----
+ possiblyNewerVersionsIn: aRepository 
+ 	^ aRepository possiblyNewerVersionsOfAnyOf:
+ 		(self ancestors collect:
+ 			[ : each | each versionName ])!
- possiblyNewerVersionsIn: aRepository
- 
- 	^aRepository possiblyNewerVersionsOfAnyOf: self ancestors!

Item was added:
+ ----- Method: MethodReference>>workingCopy (in category '*monticello') -----
+ workingCopy
+ 	"Answer the MCWorkingCopy in which I am defined."
+ 	^ self packageInfo workingCopy!

Item was added:
+ ----- Method: PackageInfo>>mcPackage (in category '*monticello') -----
+ mcPackage
+ 	^ MCPackage named: self packageName!

Item was added:
+ ----- Method: PackageInfo>>workingCopy (in category '*monticello') -----
+ workingCopy
+ 	^ self mcPackage workingCopy!

Item was removed:
- ----- Method: String>>extractNumber (in category '*monticello') -----
- extractNumber
- 	^ ('0', self select: [:ea | ea isDigit]) asNumber!

Item was added:
+ (PackageInfo named: 'Monticello') postscript: 'nil'!



More information about the Packages mailing list