[Pkg] The Trunk: Kernel-cmm.578.mcz

commits at source.squeak.org commits at source.squeak.org
Mon May 2 23:46:55 UTC 2011


Chris Muller uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-cmm.578.mcz

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

Name: Kernel-cmm.578
Author: cmm
Time: 2 May 2011, 6:46:17.696 pm
UUID: 913d762f-e361-4f5e-814f-0b0692ffa4d9
Ancestors: Kernel-ul.577

- Support for streamlined variable reference / assignment browsing.
- Fix for Month class>>#readFrom:.

=============== Diff against Kernel-ul.577 ===============

Item was added:
+ ----- Method: Behavior>>whichMethodsStoreInto: (in category 'testing method dictionary') -----
+ whichMethodsStoreInto: instVarName 
+ 	"Answer a collection of selectors whose methods access the argument, 
+ 	instVarName, as a named instance variable."
+ 	"Point whichMethodsStoreInto: 'x'."
+ 	| instVarIndex |
+ 	instVarIndex := self allInstVarNames
+ 		indexOf: instVarName
+ 		ifAbsent: [ ^ IdentitySet new ].
+ 	^ Array streamContents:
+ 		[ : stream | self methodDict keysAndValuesDo:
+ 			[ : eachSelector : eachMethod | (eachMethod writesField: instVarIndex) ifTrue: [ stream nextPut: eachMethod ] ] ]!

Item was removed:
- ----- Method: Behavior>>whichSelectorsAssign: (in category 'queries') -----
- whichSelectorsAssign: instVarName 
- 	"Answer a Set of selectors whose methods store into the argument, 
- 	instVarName, as a named instance variable."
- 	^self whichSelectorsStoreInto: instVarName!

Item was changed:
  ----- Method: Class>>allClassVarNames (in category 'class variables') -----
  allClassVarNames
+ 	"Answer a Set of the names of the receiver's class variables, including those defined in the superclasses of the receiver."
- 	"Answer a Set of the names of the receiver's class variables, including those
- 	defined in the superclasses of the receiver."
- 
  	| aSet |
+ 	^ self superclass == nil
- 	self superclass == nil
  		ifTrue: 
+ 			[self classVarNames asSet]  "This is the keys so it is a new Set."
- 			[^self classVarNames asSet]  "This is the keys so it is a new Set."
  		ifFalse: 
  			[aSet := self superclass allClassVarNames.
  			aSet addAll: self classVarNames.
+ 			aSet]!
- 			^aSet]!

Item was added:
+ ----- Method: Class>>whichMethodsStoreInto: (in category 'testing') -----
+ whichMethodsStoreInto: varName 
+ 	"Answer a collection of selectors whose methods access the argument, varName, as a named class variable."
+ 	| ref |
+ 	ref := self classPool
+ 		associationAt: varName
+ 		ifAbsent: [ ^ super whichMethodsStoreInto: varName ].
+ 	^ Array streamContents:
+ 		[ : stream | self class methodDict keysAndValuesDo:
+ 			[ : eachSelector : eachMethod | (eachMethod writesRef: ref) ifTrue: [ stream nextPut: eachMethod ] ] ]!

Item was removed:
- ----- Method: ClassDescription>>chooseInstVarThenDo: (in category 'instance variables') -----
- chooseInstVarThenDo: aBlock 
- 	"Put up a menu of all the instance variables in the receiver, and when
- the user chooses one, evaluate aBlock with the chosen variable as its
- parameter.  If the list is 6 or larger, then offer an alphabetical
- formulation as an alternative. triggered by a 'show alphabetically' item
- at the top of the list."
- 
- 	| lines labelStream allVars index count offerAlpha |
- 	(count := self allInstVarNames size) = 0 ifTrue: 
- 		[^ self inform: 'There are no
- instance variables.'].
- 
- 	allVars := OrderedCollection new.
- 	lines := OrderedCollection new.
- 	labelStream := WriteStream on: (String new: 200).
- 	(offerAlpha := count > 5)
- 		ifTrue:
- 			[lines add: 1.
- 			allVars add: 'show alphabetically'.
- 			labelStream nextPutAll: allVars first; cr].
- 	self withAllSuperclasses reverseDo:
- 		[:class | | vars |
- 		vars := class instVarNames.
- 		vars do:
- 			[:var |
- 			labelStream nextPutAll: var; cr.
- 			allVars add: var].
- 		vars isEmpty ifFalse: [lines add: allVars size]].
- 	labelStream skip: -1 "cut last CR".
- 	(lines size > 0 and: [lines last = allVars size]) ifTrue:
- 		[lines removeLast].  "dispense with inelegant line beneath last item"
- 	index := (UIManager default chooseFrom: (labelStream contents subStrings: {Character cr}) lines: lines
- title: 'Instance variables in', self name).
- 	index = 0 ifTrue: [^ self].
- 	(index = 1 and: [offerAlpha]) ifTrue: [^ self
- chooseInstVarAlphabeticallyThenDo: aBlock].
- 	aBlock value: (allVars at: index)!

Item was added:
+ ----- Method: ClassDescription>>chooseVarThenDo: (in category 'instance variables') -----
+ chooseVarThenDo: aBlock 
+ 	"Put up a menu of all the instance variables in the receiver, and when
+ the user chooses one, evaluate aBlock with the chosen variable as its
+ parameter."
+ 	| lines labelStream allVars index |
+ 	(self allInstVarNames size + self allClassVarNames size) = 0 ifTrue: [ ^ self inform: 'There are no variables.' ].
+ 	allVars := OrderedCollection new.
+ 	lines := OrderedCollection new.
+ 	labelStream := WriteStream on: (String new: 200).
+ 	self withAllSuperclasses reverseDo:
+ 		[ : class | | vars |
+ 		vars := class instVarNames , class classVarNames.
+ 		vars do:
+ 			[ : var | labelStream
+ 				 nextPutAll: var ;
+ 				 cr.
+ 			allVars add: var ].
+ 		vars isEmpty ifFalse: [ lines add: allVars size ] ].
+ 	labelStream skip: -1.
+ 	"cut last CR"
+ 	(lines size > 0 and: [ lines last = allVars size ]) ifTrue: [ lines removeLast ].
+ 	"dispense with inelegant line beneath last item"
+ 	index := UIManager default
+ 		chooseFrom: (labelStream contents subStrings: {Character cr})
+ 		lines: lines
+ 		title: 'Variables in' , self name.
+ 	index = 0 ifTrue: [ ^ self ].
+ 	aBlock value: (allVars at: index)!

Item was changed:
  ----- Method: MethodFinder>>initialize (in category 'initialize') -----
(excessive size, no diff calculated)

Item was changed:
  ----- Method: Month class>>readFrom: (in category 'squeak protocol') -----
  readFrom: aStream
  
  	| m y c |
  	m := (ReadWriteStream with: '') reset.
  	[(c := aStream next) isSeparator] whileFalse: [m nextPut: c].
  	[(c := aStream next) isSeparator] whileTrue.
  	y := (ReadWriteStream with: '') reset.
  	y nextPut: c.
  	[aStream atEnd] whileFalse: [y nextPut: aStream next].
  
  	^ self 
  		month: m contents
+ 		year: y contents asInteger
- 		year: y contents
  
  "Month readFrom: 'July 1998' readStream"!



More information about the Packages mailing list