[squeak-dev] The Trunk: System-ul.583.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Aug 8 11:32:44 UTC 2013


Levente Uzonyi uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-ul.583.mcz

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

Name: System-ul.583
Author: ul
Time: 8 August 2013, 1:21:45.26 pm
UUID: bd554495-2402-4ed7-ba43-cc4497851b9b
Ancestors: System-cmm.582

- fixed Behavior >> #allCallsOn
- #thoroughSenders is a pragma preference
- fixed ClassReference >> #setClassSymbol:classIsMeta:stringVersion:
- other minor tweaks

=============== Diff against System-cmm.582 ===============

Item was changed:
  ----- Method: Behavior>>allCallsOn (in category '*System-Support') -----
  allCallsOn
+ 	"Answer a sorted collection of all the methods that refer to me."
+ 	
+ 	^self systemNavigation allCallsOnClass: self!
- 	"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 bindingOf: theClass name)) ,
- 		(Preferences thoroughSenders
- 			ifTrue: [ self systemNavigation allCallsOn: theClass name ]
- 			ifFalse: [ OrderedCollection new ]) ,
- 		(self systemNavigation allClasses
- 			select:
- 				[ : c | c sharedPools includes: theClass ]
- 			thenCollect:
- 				[ : c | ClassReference new
- 					setClassSymbol: c name
- 					classIsMeta: false
- 					stringVersion: c name ])!

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

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

Item was removed:
- ----- Method: Preferences class>>thoroughSenders (in category 'standard queries') -----
- thoroughSenders
- 	^ self
- 		valueOfFlag: #thoroughSenders
- 		ifAbsent: [ true ]!

Item was changed:
  Object subclass: #SystemNavigation
  	instanceVariableNames: 'browserClass hierarchyBrowserClass environment'
+ 	classVariableNames: 'Default ThoroughSenders'
- 	classVariableNames: 'Default'
  	poolDictionaries: ''
  	category: 'System-Support'!
  
  !SystemNavigation commentStamp: 'mha 8/26/2010 09:02' prior: 0!
  I support the navigation of the system. I act as a facade but as I could require some state
  or different way of navigating the system all my behavior are on the instance side.
  
  
  For example if you want to look at all methods you have written or changed in the current image do
  
  SystemNavigation new browseAllSelect: [ :method |
         method fileIndex > 1 "only look at changes file"
         and: [ method timeStamp beginsWith: 'your-initials-here' ] ].
  
  !

Item was added:
+ ----- Method: SystemNavigation class>>thoroughSenders (in category 'preferences') -----
+ thoroughSenders
+ 	"Accessor for the system-wide preference"
+ 	
+ 	<preference: 'Thorough senders.'
+ 		category: #general
+ 		description: 'If true, then ''senders'' browsers will dive inside structured literals in their search.'
+ 		type: #Boolean>
+ 	^ThoroughSenders ifNil: [ true ]!

Item was added:
+ ----- Method: SystemNavigation class>>thoroughSenders: (in category 'preferences') -----
+ thoroughSenders: aBoolean
+ 	"Accessor for the system-wide preference"
+ 	
+ 	ThoroughSenders := aBoolean!

Item was added:
+ ----- Method: SystemNavigation>>allBehaviors (in category 'query') -----
+ allBehaviors
+ 
+ 	^Generator on: [ :generator |
+ 		self allBehaviorsDo: [ :each |
+ 			generator yield: each ] ]!

Item was changed:
  ----- Method: SystemNavigation>>allBehaviorsDo: (in category 'query') -----
  allBehaviorsDo: aBlock 
  	"Evaluate the argument, aBlock, for each kind of Behavior in the system 
  	(that is, Object and its subclasses and Traits).
  	ar 7/15/1999: The code below will not enumerate any obsolete or anonymous
  	behaviors for which the following should be executed:
  
  		Smalltalk allObjectsDo:[:obj| obj isBehavior ifTrue:[aBlock value: obj]].
  
  	but what follows is way faster than enumerating all objects."
  
+ 	self environment allClassesAndTraitsDo: [ :class |
+ 		aBlock
+ 			value: class;
+ 			value: class class ]!
- 	self environment allClassesAndTraitsDo: [:class |
- 		aBlock value: class.
- 		aBlock value: class class].!

Item was changed:
  ----- Method: SystemNavigation>>allCallsOn: (in category 'query') -----
  allCallsOn: aLiteral 
  	"Answer a sorted collection of all the methods that call on aLiteral even deeply embedded in literal array."
  	"self default browseAllCallsOn: #open:label:."
  	
  	^self
  		allCallsOn: aLiteral
+ 		fromBehaviors: self allBehaviors
- 		fromBehaviors: (Generator on: [ :generator |
- 			self allBehaviorsDo: [ :each |
- 				generator yield: each ] ])
  		sorted: true!

Item was changed:
  ----- Method: SystemNavigation>>allCallsOn:fromBehaviors:sorted: (in category 'query') -----
  allCallsOn: aLiteral fromBehaviors: behaviors sorted: sorted
  	"Answer a collection of all the methods implemented by behaviors that call on aLiteral even deeply embedded in literal array."
  	
  	| result special thorough byte |
  	result := OrderedCollection new.
  	special := Smalltalk hasSpecialSelector: aLiteral ifTrueSetByte: [ :b | byte := b ].
  	"Possibly search for symbols imbedded in literal arrays"
+ 	thorough := aLiteral isSymbol and: [ self class thoroughSenders ].
- 	thorough := aLiteral isSymbol and: [ Preferences thoroughSenders ].
  	behaviors do: [ :behavior |
  		| list | 
  		list := behavior whichSelectorsReferTo: aLiteral special: special byte: byte thorough: thorough.
  		list do: [ :selector |
  			result add: (MethodReference class: behavior selector: selector) ] ].
  	sorted ifTrue: [ result sort ].
  	^result!

Item was added:
+ ----- Method: SystemNavigation>>allCallsOnClass: (in category 'query') -----
+ allCallsOnClass: aBehavior
+ 	"Answer a sorted collection of all the methods that refer to aBehavior."
+ 	
+ 	| theClass result |
+ 	theClass := aBehavior theNonMetaClass.
+ 	result := self 
+ 		allCallsOn: (
+ 			self class thoroughSenders
+ 				ifTrue: [  theClass name ]
+ 				ifFalse: [ theClass environment bindingOf: theClass name ])
+ 		fromBehaviors: self allBehaviors
+ 		sorted: false.
+ 	theClass environment allClassesDo: [ :class |
+ 		(class sharedPools includes: theClass) ifTrue: [
+ 			result add: (ClassReference class: class) ] ].
+ 	^result sort!

Item was changed:
  ----- Method: SystemNavigation>>browseAllCallsOnClass: (in category 'browse') -----
  browseAllCallsOnClass: aBehavior
+ 	"Create and schedule a message browser on each method that refers to aBehavior."
- 	"Create and schedule a message browser on each method that refers to aClass."
  	"self default browseAllCallsOnClass: Array"
  	
  	| behaviorName |
  	behaviorName := aBehavior theNonMetaClass name.
  	self
+ 		browseMessageList: [ self allCallsOnClass: aBehavior ]
- 		browseMessageList: [ aBehavior allCallsOn ]
  		name: 'Users of ', behaviorName
  		autoSelect: behaviorName!

Item was changed:
+ (PackageInfo named: 'System') postscript: '"Migrate #thoroughSenders to the new pragma preference."
+ SystemNavigation thoroughSenders: Preferences thoroughSenders.
+ Preferences removePreference: #thoroughSenders.
+ '!
- (PackageInfo named: 'System') postscript: '"Remove instance of NaturalLanguageTranslator in InternalTranslator, since it breaks its own startup method."
- InternalTranslator resetCaches.
- "Remove obsolete preferences."
- #(allowUnderscoreAssignment allowBlockArgumentAssignment soundsEnabled soundQuickStart soundStopWhenDone canRecordWhilePlaying)
- 	do: [ :each | Preferences removePreference: each ].'!



More information about the Squeak-dev mailing list