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, commits@source.squeak.org 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]!
squeak-dev@lists.squeakfoundation.org