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

> This appears to have caused, when using the the "inheritance (i)"
> function, the list of methods to have indentations which weren't there
> before and interferes with the ability to begin tracing.
>
> It appears nothing was changed with the "stringVersion" of the
> MethodReference so it's not quickly evident why it's indenting...
>
> On Sun, Mar 5, 2017 at 9:57 AM,  <[hidden email]> wrote:
>> 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]!
>>
>>
>