'From Croquet1.0beta of 11 April 2006 [latest update: #2] on 15 July 2009 at 3:27:12 pm'!

!MCPackage methodsFor: 'as yet unclassified' stamp: 'kph 12/7/2008 03:31'!
snapshot

	| definitions categories packageInfo |
 
	packageInfo := self packageInfo.
	definitions := OrderedCollection new.
	categories := packageInfo systemCategories.
	
	definitions addAll: (self orphanage orphansFor: packageInfo). 
	definitions removeAllFoundIn: self orphanage unlinkedClasses.
	   
	categories isEmpty ifFalse: [ definitions add: (MCOrganizationDefinition categories: categories) ].

	packageInfo
		classesDo: [:ea | definitions addAll: ea classDefinitions]
		methodsDo: [:ea | definitions add: ea asMethodDefinition]
		displayingProgress: 'Snapshotting...'.
	
	MCScriptDefinition subclassesDo: [ :ea | ea from: packageInfo addTo: definitions ].

	MCFileDefinition from: packageInfo addTo: definitions.
	
	^ MCSnapshot fromDefinitions: definitions 
	! !


!PackageInfo methodsFor: 'single-pass' stamp: 'mtf 10/3/2008 21:37'!
behaviorsNamed: aSymbol do: aBlock
"Enumerates all behaviors with the given name"

	| class traitClass |
	class := Smalltalk at: aSymbol ifAbsent: [^ self].
	class isBehavior ifTrue: [aBlock value: class. aBlock value: class class. ^ self].
	traitClass := Smalltalk at: #Trait ifAbsent: [^ self].
	(class isKindOf: traitClass) ifTrue: [aBlock value: class. ^ self].! !

!PackageInfo methodsFor: 'single-pass' stamp: 'mtf 10/3/2008 20:45'!
classesDo: classBlock methodsDo: methodBlock
"Enumerates all non-meta classes and all methods in the package"

	self
		includedClassesDo: [:class |
			class isMeta ifFalse: [classBlock value: class].
			self methodsInIncludedClass: class do: methodBlock]
		excludedClassesDo: [:class |
			self methodsInExcludedClass: class do: methodBlock]! !

!PackageInfo methodsFor: 'single-pass' stamp: 'mtf 10/3/2008 23:18'!
classesDo: classBlock methodsDo: methodBlock displayingProgress: aString
"Enumerates all non-meta classes and all methods in the package, and displays a progress bar"

	| classes methods i |
	(1 to: 2) do: [:ignored | ] displayingProgress: 'Collecting...'.
	classes := OrderedCollection new.
	methods := OrderedCollection new.
	self
		classesDo: [:class | classes add: class]
		methodsDo: [:method | methods add: method].
	aString displayProgressAt: Sensor cursorPoint
		from: 1 to: classes size + methods size
		during: [:bar | i := 0.
			classes do: [:class | bar value: (i := i + 1). classBlock value: class].
			methods do: [:method | bar value: (i := i + 1). methodBlock value: method]]! !

!PackageInfo methodsFor: 'single-pass' stamp: 'mtf 10/3/2008 20:22'!
includedClassesDo: includedBlock excludedClassesDo: excludedBlock
"Enumerates behaviors, dividing them into included and excluded"

	self
		includedSystemCategoriesDo: [:cat |
			(SystemOrganization listAtCategoryNamed: cat) do: [:name |
				self behaviorsNamed: name do: includedBlock]]
		excludedSystemCategoriesDo: [:cat |
			(SystemOrganization listAtCategoryNamed: cat) do: [:name |
				self behaviorsNamed: name do: excludedBlock]]! !

!PackageInfo methodsFor: 'single-pass' stamp: 'mtf 10/3/2008 21:37'!
includedSystemCategoriesDo: includedBlock excludedSystemCategoriesDo: excludedBlock
"Enumerate all system categories, dividing them into included and excluded"

	SystemOrganization categories do: [:ea | (self includesSystemCategory: ea)
		ifTrue: [includedBlock value: ea]
		ifFalse: [excludedBlock value: ea]]! !

!PackageInfo methodsFor: 'single-pass' stamp: 'mtf 10/3/2008 20:58'!
methodCategoriesInClass: aClass
coreDo: coreBlock
extensionDo: extensionBlock
overrideDo: overrideBlock
"Enumerates all interesting categories in aClass. Core categories go to coreBlock. My extension categories and override categories go to extensionBlock. Foreign override categories go to overrideBlock. Foreign extension categories are ignored"

	aClass organization categories do: [:cat |
		(self isYourClassExtension: cat) ifTrue: [extensionBlock value: cat]
			ifFalse: [(self isOverrideCategory: cat) ifTrue: [overrideBlock value: cat]
				ifFalse: [(self isForeignClassExtension: cat) ifFalse: [coreBlock value: cat]]]]! !

!PackageInfo methodsFor: 'single-pass' stamp: 'mtf 10/4/2008 00:54'!
methodsInClass: aClass category: aCategory do: aBlock
"Enumerate the methods in the given class and category"

	(aClass organization listAtCategoryNamed: aCategory) do: [:selector |
		aBlock value: ((self referenceForMethod: selector ofClass: aClass) category: aCategory)]! !

!PackageInfo methodsFor: 'single-pass' stamp: 'mtf 10/3/2008 21:37'!
methodsInExcludedClass: aClass do: aBlock
"Enumerate my methods in excluded class aClass"

	self methodCategoriesInClass: aClass
		coreDo: 		[:cat | "nothing"]
		extensionDo:	[:cat | self methodsInClass: aClass category: cat do: aBlock]
		overrideDo:	[:cat | self overriddenMethodsInClass: aClass category: cat do: aBlock]! !

!PackageInfo methodsFor: 'single-pass' stamp: 'mtf 10/3/2008 21:37'!
methodsInIncludedClass: aClass do: aBlock
"Enumerate my methods in included class aClass"

	self methodCategoriesInClass: aClass
		coreDo: 		[:cat | self methodsInClass: aClass category: cat do: aBlock]
		extensionDo:	[:cat | self methodsInClass: aClass category: cat do: aBlock]
		overrideDo:	[:cat | self overriddenMethodsInClass: aClass category: cat do: aBlock]! !

!PackageInfo methodsFor: 'single-pass' stamp: 'mtf 10/3/2008 21:46'!
overriddenMethodsInClass: aClass category: aCategory do: aBlock
"Enumerate the methods in the given class and category"

	self methodsInClass: aClass category: aCategory do: [:methodRef |
		(self changeRecordForOverriddenMethod: methodRef)
			ifNotNilDo: [:changeRecord | aBlock value: changeRecord]]! !