David T. Lewis uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-jr.927.mcz

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

Name: System-jr.927
Author: jr
Time: 28 February 2017, 1:18:53.473081 am
UUID: 7c830682-637d-e94b-b695-9f1d7499e19b
Ancestors: System-ul.926

improve environment awareness of references

also support Text as stringVersion of MethodReference
(so Lexicon could use method references)

=============== Diff against System-ul.926 ===============

Item was changed:
  Object subclass: #ClassReference
+ 	instanceVariableNames: 'classSymbol stringVersion classIsMeta environment'
- 	instanceVariableNames: 'classSymbol stringVersion classIsMeta'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'System-Tools'!
  
  !ClassReference commentStamp: '<historical>' prior: 0!
  A ClassReference is is a lightweight proxy for a Class's definition.  Allows class definitions to be viewed in MessageLists
  
  Instance Variables
  	classSymbol:		Symbol for method's class (without class keyword if meta)
  	stringVersion:		the class's definition
  
  !

Item was changed:
  ----- Method: ClassReference>>= (in category 'comparisons') -----
  = anotherMethodReference 
  	"Answer whether the receiver and the argument represent the 
  	 same object."
  	^ self species == anotherMethodReference species
  	   and: [self classSymbol = anotherMethodReference classSymbol
+ 	   and: [self classIsMeta = anotherMethodReference classIsMeta
+ 	   and: [self environment == anotherMethodReference environment]]]!
- 	   and: [self classIsMeta = anotherMethodReference classIsMeta]]!

Item was changed:
  ----- Method: ClassReference>>actualClass (in category 'accessing') -----
  actualClass 
  	| actualClass |
+ 	environment ifNil: [^ nil].
+ 	actualClass := environment at: classSymbol ifAbsent: [^nil].
+ 	^classIsMeta ifTrue: [actualClass theMetaClass] ifFalse: [actualClass]!
- 	actualClass := Smalltalk at: classSymbol ifAbsent: [^nil].
- 	^classIsMeta ifTrue: [actualClass class] ifFalse: [actualClass]!

Item was added:
+ ----- Method: ClassReference>>environment (in category 'accessing') -----
+ environment
+ 
+ 	^ environment!

Item was added:
+ ----- Method: ClassReference>>hash (in category 'comparisons') -----
+ hash
+ 	"Answer a SmallInteger whose value is related to the receiver's  
+ 	identity."
+ 	^ (self species hash bitXor: self classSymbol hash)
+ 		bitXor: self environment hash!

Item was added:
+ ----- Method: ClassReference>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 	| actualClass |
+ 	"Print the receiver on a stream"
+ 	actualClass := classSymbol asString.
+ 	classIsMeta ifTrue: [actualClass := actualClass, ' class'].
+ 	super printOn: aStream.
+ 	aStream nextPutAll: ' ', actualClass!

Item was added:
+ ----- Method: ClassReference>>setClassSymbol:classIsMeta:environment:stringVersion: (in category 'initialize-release') -----
+ setClassSymbol: classSym classIsMeta: isMeta environment: anEnvironment stringVersion: aString 
+ 
+ 	classSymbol := classSym.
+ 	classIsMeta := isMeta.
+ 	stringVersion := aString, ' (definition)'.
+ 	environment := anEnvironment!

Item was changed:
  ----- Method: ClassReference>>setStandardClass: (in category 'initialize-release') -----
  setStandardClass: aClass
  
  	self
  		setClassSymbol:  aClass theNonMetaClass name
  		classIsMeta: aClass isMeta
+ 		environment: aClass environment
  		stringVersion: aClass name!

Item was changed:
  ----- Method: MethodReference class>>class:selector: (in category 'instance creation') -----
  class: aClass selector: aSelector
+ 	^ self class: aClass selector: aSelector environment: aClass environment.!
- 	^ self class: aClass selector: aSelector environment: Smalltalk globals.!

Item was changed:
  ----- Method: MethodReference>>= (in category 'comparing') -----
  = anotherMethodReference 
  	"Answer whether the receiver and the argument represent the 
  	same object."
  	^ self species == anotherMethodReference species
  		and: [self classSymbol = anotherMethodReference classSymbol
  		and: [self classIsMeta = anotherMethodReference classIsMeta
+ 		and: [self methodSymbol = anotherMethodReference methodSymbol
+ 		and: [self environment == anotherMethodReference environment]]]]!
- 		and: [self methodSymbol = anotherMethodReference methodSymbol]]]!

Item was changed:
  ----- Method: MethodReference>>asString (in category 'converting') -----
  asString
  
+ 	^(stringVersion ifNil: [ self stringVersionDefault ]) asString!
- 	^stringVersion ifNil: [ self stringVersionDefault ]!

Item was added:
+ ----- Method: MethodReference>>asStringOrText (in category 'converting') -----
+ asStringOrText
+ 
+ 	^stringVersion ifNil: [ self stringVersionDefault ]!

Item was changed:
  ----- Method: MethodReference>>setClass:methodSymbol:stringVersion: (in category 'initialize-release') -----
  setClass: aClass methodSymbol: methodSym stringVersion: aString 
  
  	classSymbol := aClass theNonMetaClass name.
  	classIsMeta := aClass isMeta.
  	methodSymbol := methodSym.
+ 	environment := aClass environment.
  	stringVersion := aString.!

Item was changed:
  ----- Method: MethodReference>>setStandardClass:methodSymbol: (in category 'initialize-release') -----
  setStandardClass: aClass methodSymbol: methodSym
  
  	classSymbol := aClass theNonMetaClass name.
+ 	environment := aClass environment.
  	classIsMeta := aClass isMeta.
  	methodSymbol := methodSym.
  	stringVersion := nil.!

Item was changed:
  ----- Method: MethodReference>>stringVersion (in category 'accessing') -----
  stringVersion
  
+ 	^stringVersion ifNil: [self asStringOrText]!
- 	^stringVersion!

Item was changed:
  ----- Method: SystemNavigation>>methodHierarchyBrowserForClass:selector: (in category 'browse') -----
  methodHierarchyBrowserForClass: aClass selector: selectorSymbol
  	"Create and schedule a message set browser on all implementors of the 
  	currently selected message selector. Do nothing if no message is selected."
  	"SystemNavigation default 
  		methodHierarchyBrowserForClass: ParagraphEditor 
  		selector: #isControlActive"
  	| list aClassNonMeta isMeta tab compiledMethod window |
  	aClass ifNil: [^ self].
  	aClass isTrait ifTrue: [^ self].
  	selectorSymbol ifNil: [^ self].
  	aClassNonMeta := aClass theNonMetaClass.
  	isMeta := aClassNonMeta ~~ aClass.
  	list := OrderedCollection new.
  	tab := ''.
  	aClass allSuperclasses reverseDo:
  		[:cl |
  		(cl includesSelector: selectorSymbol) ifTrue:
+ 			[list addLast: (MethodReference new
+ 				setClass: cl
+ 				methodSymbol: selectorSymbol
+ 				stringVersion: tab , cl name, ' ', selectorSymbol)].
- 			[list addLast: tab , cl name, ' ', selectorSymbol].
  		tab := tab , '  '].
  	aClassNonMeta allSubclassesWithLevelDo:
  		[:cl :level | | theClassOrMeta stab |
  		theClassOrMeta := isMeta ifTrue: [cl class] ifFalse: [cl].
  		(theClassOrMeta includesSelector: selectorSymbol) ifTrue:
  			[stab := ''.  1 to: level do: [:i | stab := stab , '  '].
+ 			list addLast: (MethodReference new
+ 				setClass: theClassOrMeta
+ 				methodSymbol: selectorSymbol
+ 				stringVersion: tab , stab , theClassOrMeta name, ' ', selectorSymbol)]]
- 			list addLast: tab , stab , theClassOrMeta name, ' ', selectorSymbol]]
  	 	startingLevel: 0.
  	window := self browseMessageList: list name: 'Inheritance of ' , selectorSymbol.
  	window isSystemWindow ifTrue: 
  		[ window model
  			deselectAll ; 
  			yourself.
  		compiledMethod := aClass compiledMethodAt: selectorSymbol ifAbsent:[nil].
  		compiledMethod ifNotNil: [ window model selectReference: compiledMethod methodReference ] ]!

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 := Smalltalk at: element ifAbsent: [^ self].
  	self == SystemOrganization ifTrue: [
  		SystemChangeNotifier uniqueInstance
  			class: class
  			recategorizedFrom: oldCategory
  			to: newCategory]!