Tony Garnock-Jones uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-tonyg.1224.mcz

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

Name: System-tonyg.1224
Author: tonyg
Time: 29 March 2021, 10:15:02.279821 am
UUID: 9d897d72-46fc-4205-a27b-89c7a50ac104
Ancestors: System-mt.1223

Teach SystemOrganizer about multiple environments.

=============== Diff against System-mt.1223 ===============

Item was changed:
  Categorizer subclass: #SystemOrganizer
+ 	instanceVariableNames: 'environment'
- 	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'System-Support'!
  
  !SystemOrganizer commentStamp: '<historical>' prior: 0!
  My instances provide an organization for the classes in the system, just as a ClassOrganizer organizes the messages within a class. The only difference is the methods for fileIn/Out.!

Item was changed:
  ----- Method: SystemOrganizer>>classesIn: (in category 'query') -----
  classesIn: categoryName
  
  	| classes |
  	classes := OrderedCollection new.
  	self categories withIndexCollect: [:cat :idx |
  		(categoryName match: cat)
  			ifTrue: [classes addAll: (self listAtCategoryNumber: idx)]
  			ifFalse: [nil]].
+ 	^ classes collect: [:clsName | self environment classNamed: clsName]!
- 	^ classes collect: [:clsName | Smalltalk classNamed: clsName]!

Item was changed:
  ----- Method: SystemOrganizer>>classify:under: (in category 'accessing') -----
  classify: element under: newCategory
  	| oldCategory class |
  	self flag: #environments. "do we want notifications for classes in other environments?"
  	oldCategory := self categoryOfElement: element.
  	super classify: element under: newCategory.
+ 	class := self environment at: element ifAbsent: [^ self].
- 	class := Smalltalk at: element ifAbsent: [^ self].
  	self == SystemOrganization ifTrue: [
  		SystemChangeNotifier uniqueInstance
  			class: class
  			recategorizedFrom: oldCategory
  			to: newCategory]!

Item was changed:
  ----- Method: SystemOrganizer>>commentInventory: (in category 'query') -----
  commentInventory: categoryName
  
  	"SystemOrganization commentInventory: 'Morphic*'"
  
  	| classes commentedClasses |
  	classes := OrderedCollection new.
  	self categories withIndexCollect: [:cat :idx |
  		(categoryName match: cat)
  			ifTrue: [classes addAll: (self listAtCategoryNumber: idx)]
  			ifFalse: [nil]].
+ 	commentedClasses := classes select: [:catCls | (self environment at: catCls) hasComment].
- 	commentedClasses := classes select: [:catCls | (Smalltalk at: catCls) hasComment].
  	^ 'There are ' , classes size asString , ' classes in ' , categoryName ,
  		' of which ' , commentedClasses size asString , ' have comments and ',
  		(classes size - commentedClasses size) asString , ' do not yet have comments.'
  !

Item was added:
+ ----- Method: SystemOrganizer>>environment (in category 'accessing') -----
+ environment
+ 	^ environment ifNil: [Smalltalk globals]!

Item was added:
+ ----- Method: SystemOrganizer>>environment: (in category 'accessing') -----
+ environment: anEnvironment
+ 	environment := anEnvironment!

Item was changed:
  ----- Method: SystemOrganizer>>fileOutCategory:on:initializing: (in category 'fileIn/Out') -----
  fileOutCategory: category on: aFileStream initializing: aBool
  	"Store on the file associated with aFileStream, all the traits and classes associated 
  	with the category and any requested shared pools in the right order."
  
  	| first poolSet tempClass classes traits |
  	traits := self orderedTraitsIn: category.
  	classes := self superclassOrder: category.
  	poolSet := Set new.
  	classes do:  [:class | class sharedPools do: [:eachPool | poolSet add: eachPool]].
  	poolSet size > 0 ifTrue: [
  		tempClass := Class new.
  		tempClass shouldFileOutPools ifTrue: [
  			poolSet := poolSet select: [:aPool |
+ 				tempClass shouldFileOutPool: (self environment keyAtIdentityValue: aPool)].
- 				tempClass shouldFileOutPool: (Smalltalk globals keyAtIdentityValue: aPool)].
  			poolSet do: [:aPool | tempClass fileOutPool: aPool onFileStream: aFileStream]]].
  	first := true.
  	traits, classes do: [:each | 
  		first
  			ifTrue: [first := false]
  			ifFalse: [aFileStream cr; nextPut: Character newPage; cr].
  		each
  			fileOutOn: aFileStream
  			moveSource: false
  			toFile: 0
  			initializing: false].
  	aBool ifTrue: [classes do: [:cls | cls fileOutInitializerOn: aFileStream]].!

Item was changed:
  ----- Method: SystemOrganizer>>orderedTraitsIn: (in category 'fileIn/Out') -----
  orderedTraitsIn: category 
  	"Answer an OrderedCollection containing references to the traits in the 
  	category whose name is the argument, category (a string). The traits 
  	are ordered so they can be filed in."
  
  	| behaviors traits |
  	behaviors := (self listAtCategoryNamed: category asSymbol) 
+ 			collect: [:title | self environment at: title].
- 			collect: [:title | Smalltalk at: title].
  	traits := behaviors reject: [:each | each isBehavior].
  	^traits asArray sort: [:t1 :t2 |
  		(t2 traitComposition allTraits includes: t1)
  			or: [(t1 traitComposition allTraits includes: t2) not]]!

Item was changed:
  ----- Method: SystemOrganizer>>removeMissingClasses (in category 'remove') -----
  removeMissingClasses
  	"Remove any class names that are no longer in the Smalltalk dictionary. Used for cleaning up after garbage collecting user-generated classes."
  	"SystemOrganization removeMissingClasses"
  
  	elementArray copy do: [:el |
+ 		(self environment includesKey: el) ifFalse: [self removeElement: el]].
- 		(Smalltalk includesKey: el) ifFalse: [self removeElement: el]].
  !

Item was changed:
  ----- Method: SystemOrganizer>>superclassOrder: (in category 'fileIn/Out') -----
  superclassOrder: category 
  	"Answer an OrderedCollection containing references to the classes in the 
  	category whose name is the argument, category (a string). The classes 
  	are ordered with superclasses first so they can be filed in."
  
  	| behaviors classes |
  	behaviors := (self listAtCategoryNamed: category asSymbol) 
+ 			collect: [:title | self environment at: title].
- 			collect: [:title | Smalltalk at: title].
  	classes := behaviors select: [:each | each isBehavior].
  	^ChangeSet superclassOrder: classes!