The Trunk: System-jr.927.mcz

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]!