[Pkg] The Trunk: System-ul.449.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Jul 18 18:17:44 UTC 2011


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

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

Name: System-ul.449
Author: ul
Time: 18 July 2011, 2:01:28.809 am
UUID: baaab250-ffd3-814b-9e6f-7ef5ab04f991
Ancestors: System-ul.448

SystemNavigation refactoring part 2.

=============== Diff against System-ul.448 ===============

Item was changed:
+ ----- Method: Behavior>>allCallsOn (in category '*System-Support') -----
- ----- 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."
  
+ 	^self systemNavigation allCallsOn: self theNonMetaClass name!
- 	^self  systemNavigation allCallsOn:  self theNonMetaClass name!

Item was changed:
+ ----- Method: Behavior>>allCallsOn: (in category '*System-Support') -----
- ----- Method: Behavior>>allCallsOn: (in category '*system-support') -----
  allCallsOn: aSymbol
+ 	"Answer a sorted collection of all the methods that call on aSymbol."
- 	"Answer a SortedCollection of all the methods that call on aSymbol."
  
+ 	^self systemNavigation allCallsOn: aSymbol from: self.
- 
- 	^ self  systemNavigation allCallsOn: aSymbol from: self .
  	!

Item was added:
+ ----- Method: Behavior>>allLocalCallsOn: (in category '*System-Support') -----
+ allLocalCallsOn: aSymbol
+ 	"Answer a sorted collection of all the methods that call on aSymbol, anywhere in my class hierarchy."
+ 
+ 	^self systemNavigation allCallsOn: aSymbol from: self theNonMetaClass!

Item was changed:
+ ----- Method: Behavior>>allUnsentMessages (in category '*System-Support') -----
- ----- Method: Behavior>>allUnsentMessages (in category '*system-support') -----
  allUnsentMessages
  	"Answer an array of all the messages defined by the receiver that are not sent anywhere in the system."
  
+ 	^self systemNavigation allUnSentMessagesIn: self selectors!
- 	^ SystemNavigation default allUnSentMessagesIn: self selectors!

Item was changed:
  ----- Method: SystemNavigation>>allImplementedMessages (in category 'query') -----
  allImplementedMessages
+ 	"Answer a set of all the messages that are implemented in the system."
+ 	
+ 	^self allImplementedMessagesWithout: #(() ())!
- 	"Answer a Set of all the messages that are implemented in the system."
- 	^ self allImplementedMessagesWithout: {{}. {}}!

Item was changed:
  ----- Method: SystemNavigation>>allImplementedMessagesWithout: (in category 'query') -----
+ allImplementedMessagesWithout: behaviorsAndSelectorsPair 
+ 	"Answer a set of all the selectors that are implemented in the system, computed in the absence of the supplied behaviors and selectors."
+ 	
+ 	| selectors behaviorsToReject |
+ 	selectors := IdentitySet new.
+ 	behaviorsToReject := behaviorsAndSelectorsPair first asIdentitySet.
+ 	Smalltalk allClassesAndTraitsDo: [ :behavior |
+ 		(behaviorsToReject includes: behavior name) ifFalse: [
+ 			selectors
+ 				addAll: behavior selectors;
+ 				addAll: behavior classSide selectors ] ].
+ 	behaviorsAndSelectorsPair second do: [ :each |
+ 		selectors remove: each ].
+ 	^selectors!
- allImplementedMessagesWithout: classesAndMessagesPair 
- 	"Answer a Set of all the messages that are implemented in the system,  
- 	computed in the absence of the supplied classes and messages. Note this  
- 	reports messages that are in the absent selectors set."
- 	| messages absentClasses |
- 	messages := IdentitySet new: CompiledMethod instanceCount.
- 	absentClasses := classesAndMessagesPair first.
- 	self flag: #shouldBeRewrittenUsingSmalltalkAllClassesDo:. "sd 29/04/03" 
- 	Cursor execute showWhile: [
- 		Smalltalk classNames , Smalltalk traitNames
- 			do: [:name | ((absentClasses includes: name)
- 				ifTrue: [{}]
- 				ifFalse: [{Smalltalk at: name. (Smalltalk at: name) classSide}])
- 					do: [:each | messages addAll: each selectors]]].
- 	^ messages!

Item was changed:
  ----- Method: SystemNavigation>>allImplementorsOf: (in category 'query') -----
  allImplementorsOf: aSelector 
+ 	"Answer a sorted collection of all the methods which are named aSelector."
+ 	
+ 	| result |
+ 	result := OrderedCollection new.
+ 	self allBehaviorsDo: [ :class |
+ 		(class includesSelector: aSelector) ifTrue: [
+ 			result add: (MethodReference class: class selector: aSelector) ] ].
+ 	^result sort!
- 	"Answer a SortedCollection of all the methods that implement the message 
- 	aSelector."
- 	| aCollection |
- 	aCollection := SortedCollection new.
- 	Cursor wait
- 		showWhile: [self
- 				allBehaviorsDo: [:class | (class includesSelector: aSelector)
- 						ifTrue: [aCollection
- 								add: (MethodReference new setStandardClass: class methodSymbol: aSelector)]]].
- 	^ aCollection!

Item was changed:
  ----- Method: SystemNavigation>>allImplementorsOf:localTo: (in category 'query') -----
  allImplementorsOf: aSelector localTo: aClass 
+ 	"Answer a sorted collection of all the methods that are named aSelector in, above, or below the given class."
+ 	
+ 	| result |
+ 	result := OrderedCollection new.
+ 	{ aClass theNonMetaClass. aClass theMetaClass } do: [ :baseClass |
+ 		baseClass withAllSuperAndSubclassesDoGently: [ :class | 
+ 			(class includesSelector: aSelector) ifTrue: [
+ 				result add: (MethodReference class: class selector: aSelector) ] ] ].
+ 	^result sort!
- 	"Answer a SortedCollection of all the methods that implement the message  
- 	aSelector in, above, or below the given class."
- 	| cls aCollection |
- 	aCollection := SortedCollection new.
- 	cls := aClass theNonMetaClass.
- 	Cursor wait
- 		showWhile: [cls
- 				withAllSuperAndSubclassesDoGently: [:class | (class includesSelector: aSelector)
- 						ifTrue: [aCollection
- 								add: (MethodReference new setStandardClass: class methodSymbol: aSelector)]].
- 			cls class
- 				withAllSuperAndSubclassesDoGently: [:class | (class includesSelector: aSelector)
- 						ifTrue: [aCollection
- 								add: (MethodReference new setStandardClass: class methodSymbol: aSelector)]]].
- 	^ aCollection!

Item was changed:
  ----- Method: SystemNavigation>>allImplementorsOf:localToPackage: (in category 'query') -----
  allImplementorsOf: aSelector  localToPackage: packageNameOrInfo
+ 	"Answer a sorted collection of all the methods named aSelector in the given package."
- 	"Answer a SortedCollection of all the methods that implement the message 
- 	 aSelector in the given package."
  
+ 	| result |
+ 	result := OrderedCollection new.
+ 	(self packageInfoFor: packageNameOrInfo) actualMethodsDo: [ :method |
+ 		method selector = aSelector ifTrue: [
+ 			result add: method methodReference ] ].
+ 	^result sort!
- 	| aSet |
- 	aSet := Set new.
- 	Cursor wait showWhile:
- 		[(self packageInfoFor: packageNameOrInfo) actualMethodsDo:
- 			[:m |
- 			(m selector = aSelector) ifTrue:
- 				[aSet add: m methodReference]]].
- 	^aSet!

Item was changed:
  ----- Method: SystemNavigation>>allMethodsNoDoitsSelect: (in category 'query') -----
  allMethodsNoDoitsSelect: aBlock 
  	"Like allSelect:, but strip out Doits"
+ 	
+ 	self deprecated: 'Doits are not present in MethodDictionaries anymore. Use #allMethodsSelect:'.
+ 	^self allMethodsSelect: aBlock!
- 	| aCollection |
- 	aCollection := SortedCollection new.
- 	Cursor execute
- 		showWhile: [self
- 				allBehaviorsDo: [:class | class
- 						selectorsAndMethodsDo: [:sel :m | (sel isDoIt not
- 									and: [aBlock value: m])
- 								ifTrue: [aCollection
- 										add: (MethodReference new setStandardClass: class methodSymbol: sel)]]]].
- 	^ aCollection!

Item was changed:
  ----- Method: SystemNavigation>>allMethodsSelect: (in category 'query') -----
  allMethodsSelect: aBlock 
+ 	"Answer a sorted collection of each method that, when used as the block  
- 	"Answer a SortedCollection of each method that, when used as the block  
  	argument to aBlock, gives a true result."
+ 	
+ 	| result |
+ 	result := OrderedCollection new.
+ 	self allSelectorsAndMethodsDo: [ :behavior :selector :method |
+ 		(aBlock value: method) ifTrue: [
+ 			result add: (MethodReference class: behavior selector: selector) ] ].
+ 	^result sort!
- 	| aCollection |
- 	aCollection := OrderedCollection new.
- 	Cursor execute
- 		showWhile: [self
- 				allBehaviorsDo: [:class | class
- 						selectorsAndMethodsDo: [:sel :m | (aBlock value: m)
- 								ifTrue: [aCollection
- 										add: (MethodReference new setStandardClass: class methodSymbol: sel)]]]].
- 	^ aCollection sort!

Item was changed:
  ----- Method: SystemNavigation>>allMethodsSelect:localToPackage: (in category 'query') -----
  allMethodsSelect: aBlock localToPackage: packageNameOrInfo
+ 	"Answer a sorted collection of each method in the given package for which the evaluation of aBlock with the method answers true."
- 	"Answer a SortedCollection of each method in the given package
- 	 for which the evaluation of aBlock with the metnod answers true."
  
+ 	| result |
+ 	result := OrderedCollection new.
+ 	(self packageInfoFor: packageNameOrInfo) actualMethodsDo: [ :aMethod |
+ 		(aBlock value: aMethod) ifTrue: [
+ 			result add: aMethod methodReference ] ].
+ 	^result sort!
- 	| aSet |
- 	aSet := Set new.
- 	Cursor wait showWhile:
- 		[(self packageInfoFor: packageNameOrInfo) actualMethodsDo:
- 			[:aMethod |
- 			(aBlock value: aMethod) ifTrue:
- 				[aSet add: aMethod methodReference]]].
- 	^aSet!

Item was changed:
  ----- Method: SystemNavigation>>allMethodsWithSourceString:matchCase: (in category 'query') -----
  allMethodsWithSourceString: aString matchCase: caseSensitive
+ 	"Answer a sorted collection of all the methods that contain, in source code, aString as a substring. Search the class comments also"
- 	"Answer a SortedCollection of all the methods that contain, in source code, aString as a substring.  Search the class comments also"
  
+ 	| result |
+ 	result := OrderedCollection new.
+ 	CurrentReadOnlySourceFiles cacheDuring: [
+ 		'Searching all source code...'
+ 			displayProgressFrom: 0 to: Smalltalk classNames size
+ 			during: [ :bar |
+ 				| count previousBehavior |
+ 				count := 0.
+ 				previousBehavior := nil.
+ 				self allSelectorsAndMethodsDo: [ :behavior :selector :method |
+ 					behavior == previousBehavior ifFalse: [
+ 						bar value: (count := count + 1).
+ 						previousBehavior := behavior.
+ 						(behavior organization classComment asString
+ 							includesSubstring: aString
+ 							caseSensitive: caseSensitive) ifTrue: [
+ 								result add: (MethodReference class: behavior selector: #Comment) ] ].
+ 					(method getSource asString
+ 						includesSubstring: aString
+ 						caseSensitive: caseSensitive) ifTrue: [
+ 							result add: (MethodReference class: behavior selector: selector) ] ] ] ].
+ 	^result sort!
- 	| list adder |
- 	list := Set new.
- 	adder := [ :mrClass :mrSel | list add: ( MethodReference new
- 											setStandardClass: mrClass
- 											methodSymbol: mrSel)].
- 	'Searching all source code...'
- 		displayProgressFrom: 0 to: Smalltalk classNames size
- 		during: [:bar | | count |
- 			count := 0.
- 			SystemNavigation default allBehaviorsDo: [:each |
- 				bar value: (count := count + 1).
- 					each selectorsDo: [:sel | 
- 						((each sourceCodeAt: sel) findString: aString 
- 							startingAt: 1 caseSensitive: caseSensitive) > 0 ifTrue: [
- 								sel isDoIt ifFalse: [adder value: each value: sel]]].
- 					(each organization classComment asString findString: aString 
- 							startingAt: 1 caseSensitive: caseSensitive) > 0 ifTrue: [
- 								adder value: each value: #Comment]	]].
- 			^ list asSortedCollection!

Item was changed:
  ----- Method: SystemNavigation>>allPrimitiveMethods (in category 'query') -----
  allPrimitiveMethods
+ 	"Answer a collection of all the methods that are implemented by primitives."
+ 
+ 	| result |
+ 	result := OrderedCollection new.
+ 	self allSelectorsAndMethodsDo: [ :behavior :selector :method |
+ 		method primitive ~= 0 ifTrue: [
+ 			result add: (String streamContents: [ :stream |
+ 				stream
+ 					nextPutAll: behavior name;
+ 					space;
+ 					nextPutAll: selector;
+ 					space;
+ 					print: method primitive ]) ] ].
+ 	^result!
- 	"Answer an OrderedCollection of all the methods that are implemented by primitives."
- 	| aColl |
- 	aColl := OrderedCollection new: 200.
- 	Cursor execute
- 		showWhile: [self allBehaviorsDo: [:class | class
- 						selectorsAndMethodsDo: [:sel :method | 
- 							method primitive ~= 0
- 								ifTrue: [aColl addLast: class name , ' ' , sel , ' ' , method primitive printString]]]].
- 	^ aColl!

Item was changed:
  ----- Method: SystemNavigation>>allPrimitiveMethodsInCategories: (in category 'query') -----
  allPrimitiveMethodsInCategories: aList 
  	"Answer an OrderedCollection of all the methods that are implemented by 
  	primitives in the given categories. 1/26/96 sw"
  	"SystemNavigation new allPrimitiveMethodsInCategories:  
  	#('Collections-Streams' 'Files-Streams' 'Files-Abstract' 'Files-Macintosh')"
  
+ 	| result categories |
+ 	result := OrderedCollection new.
+ 	categories := aList collect: [ :each | each asSymbol ].
+ 	categories size > 10 ifTrue: [ categories := categories asIdentitySet ].
+ 	self allBehaviorsDo: [ :behavior | 
+ 		(aList includes: behavior category) ifTrue: [
+ 			behavior selectorsAndMethodsDo: [ :selector :method | 
+ 				method primitive ~= 0 ifTrue: [
+ 					result add: (String streamContents: [ :stream |
+ 						stream
+ 							nextPutAll: behavior name;
+ 							space;
+ 							nextPutAll: selector;
+ 							space;
+ 							print: method primitive ]) ] ] ] ].
+ 	^result!
- 	| aColl |
- 	aColl := OrderedCollection new: 200.
- 	Cursor execute
- 		showWhile: [self
- 				allBehaviorsDo: [:aClass | (aList includes: (SystemOrganization categoryOfElement: aClass theNonMetaClass name asString) asString)
- 						ifTrue: [aClass
- 								selectorsAndMethodsDo: [:sel :method | 
- 									method primitive ~= 0
- 										ifTrue: [aColl addLast: aClass name , ' ' , sel , ' ' , method primitive printString]]]]].
- 	^ aColl!

Item was added:
+ ----- Method: SystemNavigation>>allSelect: (in category 'query') -----
+ allSelect: aBlock 
+ 	"Answer a sorted collection of each method that, when used as the block argument to aBlock, gives a true result."
+ 
+ 	| result |
+ 	result := OrderedCollection new.
+ 	self allSelectorsAndMethodsDo: [ :behavior :selector :method |
+ 		(aBlock value: method) ifTrue: [
+ 			result add: behavior name , ' ' , selector ] ].
+ 	^result sort!

Item was added:
+ ----- Method: SystemNavigation>>allSelectorsAndMethodsDo: (in category 'query') -----
+ allSelectorsAndMethodsDo: aBlock 
+ 	"Evaluate aBlock for all selectors and methods of all behaviors in this image."
+ 	
+ 	self allBehaviorsDo: [ :behavior |
+ 		behavior selectorsAndMethodsDo: [ :selector :method |
+ 			aBlock value: behavior value: selector value: method ] ]!

Item was added:
+ ----- Method: SystemNavigation>>allUncommentedMethodsWithInitials: (in category 'query') -----
+ allUncommentedMethodsWithInitials: targetInitials
+ 	"Return a sorted collection with all uncommented methods whose initials (in the
+ 	time-stamp, as logged to disk) match the given initials, in chronological order."
+ 
+ 	^CurrentReadOnlySourceFiles cacheDuring: [
+ 		| result |
+ 		result := OrderedCollection new.
+ 		self allSelectorsAndMethodsDo: [ :behavior :selector :method |
+ 			method timeStamp ifNotEmptyDo: [ :timeStamp |
+ 				| initials |
+ 				initials := timeStamp substrings first.
+ 				initials first isDigit ifFalse: [
+ 					(initials = targetInitials and: [ 
+ 						(behavior firstPrecodeCommentFor: selector) isNil ]) ifTrue: [
+ 							result add: (MethodReference
+ 								class: behavior
+ 								selector: selector ) ] ] ] ].
+ 		result ]!

Item was changed:
  ----- Method: SystemNavigation>>allUnimplementedCalls (in category 'query') -----
  allUnimplementedCalls
+ 	"Answer a collection of each message that is sent by an expression in a method but is not implemented by any object in the system."
+ 
+ 	| result implementedMessages |
+ 	implementedMessages := self allImplementedMessages.
+ 	result := OrderedCollection new.
+ 	self allSelectorsAndMethodsDo: [ :behavior :selector :method |
+ 		method messagesDo: [ :each |
+ 			(implementedMessages includes: each) ifFalse: [
+ 					result add: (String streamContents: [ :stream |
+ 						stream
+ 							nextPutAll: behavior name;
+ 							space;
+ 							nextPutAll: selector;
+ 							space;
+ 							nextPutAll: 'calls: ';
+ 							nextPutAll: each ]) ] ] ].
+ 	^result!
- 	"Answer an Array of each message that is sent by an expression in a  
- 	method but is not implemented by any object in the system."
- 	| aStream all |
- 	all := self allImplementedMessages.
- 	aStream := WriteStream
- 				on: (Array new: 50).
- 	Cursor execute
- 		showWhile: [self
- 				allBehaviorsDo: [:cl | cl
- 						selectorsAndMethodsDo: [:sel :method |
- 							| secondStream | 
- 							secondStream := WriteStream
- 										on: (String new: 5).
- 							method messages
- 								do: [:m | (all includes: m)
- 										ifFalse: [secondStream nextPutAll: m;
- 												 space]].
- 							secondStream position = 0
- 								ifFalse: [aStream nextPut: cl name , ' ' , sel , ' calls: ' , secondStream contents]]]].
- 	^ aStream contents!

Item was changed:
  ----- Method: SystemNavigation>>allUnimplementedNonPrimitiveCalls (in category 'query') -----
  allUnimplementedNonPrimitiveCalls
+ 	"Answer an collection of each message that is sent by an expression in a method but is not implemented by any object in the system. This list won't include primitive methods."
+ 
+ 	| result implementedMessages |
+ 	implementedMessages := self allImplementedMessages.
+ 	result := OrderedCollection new.
+ 	self allSelectorsAndMethodsDo: [ :behavior :selector :method |
+ 		method primitive = 0 ifTrue: [
+ 			method messagesDo: [ :each |
+ 				(implementedMessages includes: each) ifFalse: [
+ 					result add: (String streamContents: [ :stream |
+ 						stream
+ 							nextPutAll: behavior name;
+ 							space;
+ 							nextPutAll: selector;
+ 							space;
+ 							nextPutAll: 'calls: ';
+ 							nextPutAll: each ]) ] ] ] ].
+ 	^result!
- 	"Answer an Array of each message that is sent by an expression in a  
- 	method but is not implemented by any object in the system."
- 	| aStream all |
- 	all := self systemNavigation allImplementedMessages.
- 	aStream := WriteStream
- 				on: (Array new: 50).
- 	Cursor execute
- 		showWhile: [self systemNavigation
- 				allBehaviorsDo: [:cl | cl
- 						selectorsAndMethodsDo: [:sel :meth |
- 							| secondStream | 
- 							secondStream := WriteStream
- 										on: (String new: 5).
- 							meth primitive = 0 ifTrue: [
- 								meth messages
- 									do: [:m | (all includes: m)
- 											ifFalse: [secondStream nextPutAll: m;
- 													 space]].
- 								secondStream position = 0
- 									ifFalse: [aStream nextPut: cl name , ' ' , sel , ' calls: ' , secondStream contents]]]]].
- 	^ aStream contents!

Item was changed:
  ----- Method: SystemNavigation>>browseAllImplementorsOfList:title: (in category 'browse') -----
  browseAllImplementorsOfList: selectorList title: aTitle 
+ 	"Create and schedule a message browser on each method that implements the message whose selector is in the argument selectorList."
+ 	"For example, self new browseAllImplementorsOf: #(at:put: size). "
+ 	
+ 	| implementorLists |
+ 	implementorLists := selectorList gather: [:each | 
+ 		self allImplementorsOf: each ].
+ 	implementorLists sort.
+ 	^self browseMessageList: implementorLists name: aTitle!
- 	"Create and schedule a message browser on each method that implements 
- 	the message whose selector is in the argument selectorList. For 
- 	example,  
- 	self new browseAllImplementorsOf: #(at:put: size).  
- 	1/16/96 sw: this variant adds the title argument.  
- 	1/24/96 sw: use a SortedCollection  
- 	2/1/96 sw: show normal cursor"
- 	| implementorLists flattenedList |
- 	implementorLists := selectorList
- 				collect: [:each | self allImplementorsOf: each].
- 	flattenedList := SortedCollection new.
- 	implementorLists
- 		do: [:each | flattenedList addAll: each].
- 	Cursor normal show.
- 	^ self browseMessageList: flattenedList name: aTitle!

Item was changed:
  ----- Method: SystemNavigation>>browseAllSelect:name:autoSelect: (in category 'browse') -----
  browseAllSelect: aBlock name: aName autoSelect: autoSelectString 
  	"Create and schedule a message browser on each method that, when used 
  	as the block argument to aBlock gives a true result. Do not return an  
  	#DoIt traces."
  	"self new browseAllSelect: [:method | method numLiterals > 10] name:  
  	'Methods with more than 10 literals' autoSelect: 'isDigit'"
  	^ self
+ 		browseMessageList: [ self allMethodsSelect: aBlock ]
- 		browseMessageList: (self allMethodsNoDoitsSelect: aBlock)
  		name: aName
  		autoSelect: autoSelectString!

Item was changed:
  ----- Method: SystemNavigation>>browseMethodsWhoseNamesContain: (in category 'browse') -----
  browseMethodsWhoseNamesContain: aString
  	"Launch a tool which shows all methods whose names contain the given string; case-insensitive.
  ·	1/16/1996 sw, at the dawn of Squeak: this was the classic implementation that provided the underpinning for the 'method names containing it' (cmd-shift-W) feature that has always been in Squeak -- the feature that later inspired the MethodFinder (aka SelectorBrowser).
  ·	sw 7/27/2001:	Switched to showing a MessageNames tool rather than a message-list browser, if in Morphic."
  
  	| aList |
  	Smalltalk isMorphic
  		ifFalse:
  			[aList := Symbol selectorsContaining: aString.
  			aList size > 0 ifTrue:
+ 				[self browseAllImplementorsOfList: aList title: 'Methods whose names contain ''', aString, '''']]
- 				[self browseAllImplementorsOfList: aList asSortedCollection title: 'Methods whose names contain ''', aString, '''']]
  
  		ifTrue:
  			[ToolSet browseMessageNames: aString]
  	!

Item was changed:
  ----- Method: SystemNavigation>>browseUncommentedMethodsWithInitials: (in category 'browse') -----
  browseUncommentedMethodsWithInitials: targetInitials
+ 	"Browse uncommented methods whose initials (in the time-stamp, as logged to disk) match the given initials.  Present them in chronological order.  CAUTION: It will take several seconds for this to complete."
- 	"Browse uncommented methods whose initials (in the time-stamp, as logged to disk) match the given initials.  Present them in chronological order.  CAUTION: It will take several minutes for this to complete."
  	"Time millisecondsToRun: [SystemNavigation default browseUncommentedMethodsWithInitials: 'jm']"
  
+ 	self
+ 		browseMessageList: [ self allUncommentedMethodsWithInitials: targetInitials ] 
- 	| methodReferences |
- 	methodReferences := OrderedCollection new.
- 	self  allBehaviorsDo:
- 		[:aClass | aClass selectorsAndMethodsDo: [:sel :cm |
- 			| timeStamp initials |
- 			timeStamp := Utilities timeStampForMethod: cm.
- 			timeStamp isEmpty ifFalse:
- 				[initials := timeStamp substrings first.
- 				initials first isDigit ifFalse:
- 					[((initials = targetInitials) and: [(aClass firstPrecodeCommentFor: sel) isNil])
- 						ifTrue:
- 							[methodReferences add: (MethodReference new
- 								setStandardClass: aClass 
- 								methodSymbol: sel)]]]]].
- 
- 	ToolSet
- 		browseMessageSet: methodReferences 
  		name: 'Uncommented methods with initials ', targetInitials
  		autoSelect: nil!

Item was changed:
  ----- Method: SystemNavigation>>selectAllMethods: (in category 'query') -----
  selectAllMethods: aBlock 
  	"Answer a SortedCollection of each method that, when used as the block  
  	argument to aBlock, gives a true result."
+ 	
+ 	self deprecated: 'Use #allMethodsSelect:'.
+ 	^self allMethodsSelect: aBlock!
- 	| aCollection |
- 	aCollection := SortedCollection new.
- 	Cursor execute
- 		showWhile: [self
- 				allBehaviorsDo: [:class | class
- 						selectorsAndMethodsDo: [:sel :m | (aBlock value: m)
- 								ifTrue: [aCollection
- 										add: (MethodReference new setStandardClass: class methodSymbol: sel)]]]].
- 	^ aCollection!

Item was changed:
  ----- Method: SystemNavigation>>selectAllMethodsNoDoits: (in category 'query') -----
  selectAllMethodsNoDoits: aBlock 
  	"Like allSelect:, but strip out Doits"
+ 	
+ 	self deprecated: 'Doits are not present in MethodDictionaries anymore. Use #allMethodsSelect:'.
+ 	^self allMethodsSelect: aBlock!
- 	| aCollection |
- 	aCollection := SortedCollection new.
- 	Cursor execute
- 		showWhile: [self
- 				allBehaviorsDo: [:class | class
- 						selectorsAndMethodsDo: [:sel :m | (sel isDoIt not
- 									and: [aBlock value: m])
- 								ifTrue: [aCollection
- 										add: (MethodReference new setStandardClass: class methodSymbol: sel)]]]].
- 	^ aCollection!

Item was changed:
  ----- Method: SystemNavigation>>unimplemented (in category 'query') -----
  unimplemented
+ 	"Answer an collection of each message that is sent by an expression in a method but is not implemented by any object in the system."
- 	"Answer an Array of each message that is sent by an expression in a method but is not implemented by any object in the system."
  
+ 	| implemented unimplemented |
+ 	implemented := self allImplementedMessages.
- 	| all unimplemented |
- 	all := IdentitySet new: Symbol instanceCount * 2.
- 	Cursor wait showWhile: 
- 		[self allBehaviorsDo: [:cl | cl selectorsDo: [:aSelector | all add: aSelector]]].
- 
  	unimplemented := IdentityDictionary new.
+ 	self allSelectorsAndMethodsDo: [ :behavior :selector :method |
+ 		method messagesDo: [ :each |
+ 			| entry |
+ 			(implemented includes: each) ifFalse: [
+ 				entry := unimplemented 
+ 					at: each 
+ 					ifPresent: [ :oldEntry |
+ 						oldEntry copyWith: behavior name, '>', selector ]
+ 					ifAbsent: [ 
+ 						{ behavior name, '>', selector } ].
+ 				unimplemented at: each put: entry ] ] ].
+ 	^unimplemented!
- 	Cursor execute showWhile: [
- 		self allBehaviorsDo: [:cl |
- 			 cl selectorsAndMethodsDo: [:sel :meth |
- 				meth messages do: [:m | | entry |
- 					(all includes: m) ifFalse: [
- 						entry := unimplemented at: m ifAbsent: [Array new].
- 						entry := entry copyWith: (cl name, '>', sel).
- 						unimplemented at: m put: entry]]]]].
- 	^ unimplemented
- !

Item was changed:
  ----- Method: SystemNavigation>>unusedBlocks (in category 'query') -----
  unusedBlocks
  	"Answer all methods that contain a block that is not used (not
  	 sent a message, returned, passed as an argument, or assigned)."
  	"SystemNavigation new unusedBlocks"
  	"SystemNavigation new
  		browseMessageList: SystemNavigation new unusedBlocks
  		name: 'unused blocks'"
+ 
+ 	^self allMethodsSelect:
- 	^self allSelect:
  		[:m| | is |
  		is := InstructionStream on: m.
  		is scanFor: [:b| b = 143 and: [(m at: is thirdByte * 256 + is fourthByte + is pc + 4) = 135]]]!



More information about the Packages mailing list