[squeak-dev] The Trunk: System-jr.927.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun Mar 5 15:53:49 UTC 2017
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]!
More information about the Squeak-dev
mailing list
|