The Trunk: System-eem.487.mcz

Eliot Miranda uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-eem.487.mcz

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

Name: System-eem.487
Author: eem
Time: 19 May 2012, 5:29:05.713 pm
UUID: 6133ab9f-374a-4017-83ee-900d8c216204
Ancestors: System-eem.486

Add ClassReference which allows class definitions to
appear alongside method definitions in MessageSets.
Improve Behavior>allCallsOn: to include users of shared pools.
Hence with these two, doing class refs on a shared pool
lists the lcasses that use the pool

=============== Diff against System-eem.486 ===============

Item was changed:
  ----- Method: Behavior>>allCallsOn (in category '*System-Support') -----
  allCallsOn
  "Answer a SortedCollection of all the methods that refer to me by name or as part of an association in a global dict."
 
+ | theClass |
+ theClass := self theNonMetaClass.
+ ^(self  systemNavigation allCallsOn:  (self environment associationAt: theClass name)),
+  (Preferences thoroughSenders
+ ifTrue: [OrderedCollection new]
+ ifFalse: [self  systemNavigation allCallsOn: theClass name]),
+  (self systemNavigation allClasses
+ select: [:c| c sharedPools includes: theClass]
+ thenCollect:
+ [:c|
+ ClassReference new
+ setClassSymbol: c name
+ classIsMeta: false
+ stringVersion: c name])!
- ^self systemNavigation allCallsOn: self theNonMetaClass name!

Item was added:
+ Object subclass: #ClassReference
+ 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 added:
+ ----- Method: ClassReference class>>class: (in category 'instance creation') -----
+ class: aClass
+ ^ self new setStandardClass: aClass!

Item was added:
+ ----- Method: ClassReference>><= (in category 'comparisons') -----
+ <= anotherMethodOrClassReference
+
+ classSymbol < anotherMethodOrClassReference classSymbol ifTrue: [^true].
+ classSymbol > anotherMethodOrClassReference classSymbol ifTrue: [^false].
+ classIsMeta = anotherMethodOrClassReference classIsMeta ifFalse: [^classIsMeta not].
+ "i.e. if anotherMethodOrClassReference is a MethodReference then we're < it, and so <= to it"
+ ^true!

Item was added:
+ ----- 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]]!

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

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

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

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

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

Item was added:
+ ----- Method: ClassReference>>isClassReference (in category 'comparisons') -----
+ isClassReference
+ ^true!

Item was added:
+ ----- Method: ClassReference>>isMethodReference (in category 'comparisons') -----
+ isMethodReference
+ ^false!

Item was added:
+ ----- Method: ClassReference>>setClassAndSelectorIn: (in category 'setting') -----
+ setClassAndSelectorIn: csBlock
+
+ ^csBlock value: self actualClass value: #Definition!

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

Item was added:
+ ----- Method: ClassReference>>setStandardClass: (in category 'initialize-release') -----
+ setStandardClass: aClass
+
+ classSymbol := aClass theNonMetaClass name.
+ classIsMeta := aClass isMeta.
+ stringVersion := aClass name, ' (definition)'!

Item was added:
+ ----- Method: ClassReference>>sourceString (in category 'queries') -----
+ sourceString
+ ^self actualClass definition!

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

Item was added:
+ ----- Method: SystemNavigation class>>doesNotUnderstand: (in category 'error handling') -----
+ doesNotUnderstand: aMessage
+ (self includesSelector: aMessage selector) ifTrue:
+ [^self default perform: aMessage selector withArguments: aMessage arguments].
+ ^super doesNotUnderstand: aMessage!