[squeak-dev] The Trunk: System-mt.1078.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Aug 2 12:36:54 UTC 2019


Marcel Taeumel uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-mt.1078.mcz

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

Name: System-mt.1078
Author: mt
Time: 2 August 2019, 2:36:47.057946 pm
UUID: 7e1a1567-d617-dd42-aa20-a69264d0fea4
Ancestors: System-mt.1077

Adds missing returns of (constructed) tool windows to system navigation's browse*-calls. Many were already there. Note that there is the non-browse-interface in system navigation to just execute and return queries such as #allCallsOn: vs. #browseAllCallsOn:.

=============== Diff against System-mt.1077 ===============

Item was changed:
  ----- Method: SystemNavigation>>browseAllCallsOn: (in category 'browse') -----
  browseAllCallsOn: aLiteral 
  	"Create and schedule a message browser on each method that refers to aLiteral."
  	"self default browseAllCallsOn: #open:label:."
  
+ 	^ self headingAndAutoselectForLiteral: aLiteral do: [ :label :autoSelect |
- 	self headingAndAutoselectForLiteral: aLiteral do: [ :label :autoSelect |
  		self
  			browseMessageList: [ self allCallsOn: aLiteral ]
  			name: label
  			autoSelect: autoSelect]!

Item was changed:
  ----- Method: SystemNavigation>>browseAllCallsOn:and:localToPackage: (in category 'browse') -----
  browseAllCallsOn: literal1 and: literal2 localToPackage: packageNameOrInfo
  	"Create and schedule a message browser on each method in the given package that refers to both literal1 and literal2."
  	"self default browseAllCallsOn: #open:label: localToPackage: 'Tools'."
  
+ 	^ self headingAndAutoselectForLiteral: literal1 do: [ :label :autoSelect |
- 	self headingAndAutoselectForLiteral: literal1 do: [ :label :autoSelect |
  		self
  			browseMessageList: [ 
  				self 
  					allCallsOn: literal1
  					and: literal2
  					localToPackage: packageNameOrInfo ]
  			name: label, ' local to package ', (self packageInfoFor: packageNameOrInfo) name
  			autoSelect: autoSelect ]!

Item was changed:
  ----- Method: SystemNavigation>>browseAllCallsOn:localTo: (in category 'browse') -----
  browseAllCallsOn: aLiteral localTo: aBehavior
  	"Create and schedule a message browser on each method in or below the given class that refers to aLiteral."
  	"self default browseAllCallsOn: #open:label: localTo: CodeHolder"
  
  	aBehavior ifNil: [ ^self inform: 'No behavior selected.' ].
+ 	^ self headingAndAutoselectForLiteral: aLiteral do: [ :label :autoSelect |
- 	self headingAndAutoselectForLiteral: aLiteral do: [ :label :autoSelect |
  		self
  			browseMessageList:  [ self allCallsOn: aLiteral from: aBehavior ]
  			name: label, ' local to ', aBehavior name
  			autoSelect: autoSelect ]!

Item was changed:
  ----- Method: SystemNavigation>>browseAllCallsOn:localToPackage: (in category 'browse') -----
  browseAllCallsOn: aLiteral localToPackage: packageNameOrInfo
  	"Create and schedule a message browser on each method in the given package that refers to aLiteral."
  	"self default browseAllCallsOn: #open:label: localToPackage: 'Tools'."
  
+ 	^ self headingAndAutoselectForLiteral: aLiteral do: [ :label :autoSelect |
- 	self headingAndAutoselectForLiteral: aLiteral do: [ :label :autoSelect |
  		self
  			browseMessageList: [ 
  				self 
  					allCallsOn: aLiteral
  					localToPackage: packageNameOrInfo ]
  			name: label, ' local to package ', (self packageInfoFor: packageNameOrInfo) name
  			autoSelect: autoSelect ]!

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

Item was changed:
  ----- Method: SystemNavigation>>browseAllImplementorsOf:localToPackage: (in category 'browse') -----
  browseAllImplementorsOf: selector localToPackage: packageNameOrInfo
  	"Create and schedule a message browser on each method in the given package
  	that implements the message whose selector is the argument, selector. For example, 
  	SystemNavigation new browseAllImplementorsOf: #at:put: localToPackage: 'Collections'."
  
+ 	^ self browseMessageList: (self
- 	self browseMessageList: (self
  								allImplementorsOf: selector
  								localToPackage: packageNameOrInfo)
  		name: 'Implementors of ' , selector,
  				' local to package ', (self packageInfoFor: packageNameOrInfo) name!

Item was changed:
  ----- Method: SystemNavigation>>browseAllImplementorsOfList: (in category 'browse') -----
  browseAllImplementorsOfList: selectorList
  	"Create and schedule a message browser on each method that implements 
  	the message whose selector is in the argument selectorList. For example, 
  	Smalltalk browseAllImplementorsOf: #(at:put: size).
  	1/16/96 sw: defer to the titled version"
  
+ 	^ self browseAllImplementorsOfList: selectorList title: 'Implementors of all'!
- 	self browseAllImplementorsOfList: selectorList title: 'Implementors of all'!

Item was changed:
  ----- Method: SystemNavigation>>browseAllObjectReferencesTo:except:ifNone: (in category 'browse') -----
  browseAllObjectReferencesTo: anObject except: objectsToExclude ifNone: aBlock 
  	"Bring up a list inspector on the objects that point to anObject.
  	If there are none, then evaluate aBlock on anObject.  "
  
  	| aList shortName |
  	aList := Utilities pointersTo: anObject except: objectsToExclude.
  	aList size > 0 ifFalse: [^aBlock value: anObject].
  	shortName := (anObject name ifNil: [anObject printString]) contractTo: 20.
+ 	^ aList inspectWithLabel: 'Objects pointing to ' , shortName!
- 	aList inspectWithLabel: 'Objects pointing to ' , shortName!

Item was changed:
  ----- Method: SystemNavigation>>browseAllReferencesToPool:from: (in category 'browse') -----
  browseAllReferencesToPool: poolOrName from: aClass
  	"Open a message list on all messages referencing the given pool"
  	| pool list |
  	(poolOrName isString)
  		ifTrue:[pool := Smalltalk at: poolOrName asSymbol]
  		ifFalse:[pool := poolOrName].
  	list := self allReferencesToPool: pool from: aClass.
+ 	^ self
- 	self
  		browseMessageList: list
+ 		name: 'users of ', poolOrName name!
- 		name: 'users of ', poolOrName name.
- 	^list!

Item was changed:
  ----- Method: SystemNavigation>>browseAllUnSentMessages (in category 'browse') -----
  browseAllUnSentMessages
  	"Create and schedule a message browser on each method whose message is  not sent in any method in the system."
  	"self new browseAllUnSentMessages"
  
+ 	^ self browseAllImplementorsOfList: self allUnSentMessages title: 'Messages implemented but not sent'!
- 	self browseAllImplementorsOfList: self allUnSentMessages title: 'Messages implemented but not sent'
- !

Item was changed:
  ----- Method: SystemNavigation>>browseAllUnimplementedCalls (in category 'browse') -----
  browseAllUnimplementedCalls
  	"Create and schedule a message browser on each method that includes a 
  	message that is not implemented in any object in the system."
  
+ 	^self browseMessageList: self allUnimplementedCalls name: 'Unimplemented calls'!
- 	^self   browseMessageList: self allUnimplementedCalls name: 'Unimplemented calls'!

Item was changed:
  ----- Method: SystemNavigation>>browseClass: (in category 'browse') -----
  browseClass: aBehavior
  	| targetClass |
  	targetClass := aBehavior isMeta
  				ifTrue: [aBehavior theNonMetaClass]
  				ifFalse: [aBehavior ].
+ 	^ ToolSet browse: targetClass selector: nil!
- 	ToolSet browse: targetClass selector: nil!

Item was changed:
  ----- Method: SystemNavigation>>browseClassesWithNamesContaining:caseSensitive: (in category 'browse') -----
  browseClassesWithNamesContaining: aString caseSensitive: caseSensitive 
  	"SystemNavigation default browseClassesWithNamesContaining: 'eMorph' caseSensitive: true "
  	"Launch a class-list list browser on all classes whose names containg aString as a substring."
  
  	| suffix aList |
  	suffix := caseSensitive
  				ifTrue: [' (case-sensitive)']
  				ifFalse: [' (use shift for case-sensitive)'].
  	aList := OrderedCollection new.
  	Cursor wait
  		showWhile: [Smalltalk
  				allClassesDo: [:class | (class name includesSubstring: aString caseSensitive: caseSensitive)
  						ifTrue: [aList add: class name]]].
+ 	^ ToolSet openClassListBrowser: aList asSet sorted title: 'Classes whose names contain ' , aString , suffix!
- 	aList size > 0
- 		ifTrue: [ToolSet openClassListBrowser: aList asSet sorted title: 'Classes whose names contain ' , aString , suffix]!

Item was changed:
  ----- Method: SystemNavigation>>browseHierarchy: (in category 'browse') -----
  browseHierarchy: aBehavior
  	| targetClass |
  	targetClass := aBehavior isMeta
  				ifTrue: [aBehavior theNonMetaClass]
  				ifFalse: [aBehavior ].
+ 	^ ToolSet browseHierarchy: targetClass selector: nil!
- 	ToolSet browseHierarchy: targetClass selector: nil.!

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."
  
+ 	^ Smalltalk isMorphic
+ 		ifTrue: [ToolSet browseMessageNames: aString]
+ 		ifFalse: [
+ 			self
+ 				browseAllImplementorsOfList: (Symbol selectorsContaining: aString)
+ 				title: 'Methods whose names contain ''', aString, '''']!
- 	| aList |
- 	Smalltalk isMorphic
- 		ifFalse:
- 			[aList := Symbol selectorsContaining: aString.
- 			aList size > 0 ifTrue:
- 				[self browseAllImplementorsOfList: aList title: 'Methods whose names contain ''', aString, '''']]
- 
- 		ifTrue:
- 			[ToolSet browseMessageNames: aString]
- 	!

Item was changed:
  ----- Method: SystemNavigation>>browseMethodsWithLiteral: (in category 'browse') -----
  browseMethodsWithLiteral: aString
  	"Launch a browser on all methods that contain string literals with aString as a substring. Make the search case-sensitive or insensitive as dictated by the caseSensitive boolean parameter"
  
+ 	^ self browseAllSelect:
- 	self browseAllSelect:
  			[:method |
  				method hasLiteralSuchThat: [:lit |
  					(lit isString and: [lit isSymbol not]) and:
  					[lit = aString]]]
  		name:  'Methods with string ', aString printString
+ 		autoSelect: aString!
- 		autoSelect: aString.
- !

Item was changed:
  ----- Method: SystemNavigation>>browseMethodsWithString:matchCase: (in category 'browse') -----
  browseMethodsWithString: aString matchCase: caseSensitive
  	"Launch a browser on all methods that contain string literals with aString as a substring. Make the search case-sensitive or insensitive as dictated by the caseSensitive boolean parameter"
  
+ 	^ self 
- 	self 
  		browseMessageList: (self allMethodsWithString: aString matchCase: caseSensitive)
  		name:  'Methods with string ', aString printString, (caseSensitive ifTrue: [' (case-sensitive)'] ifFalse: [' (case-insensitive)'])
  		autoSelect: aString!

Item was changed:
  ----- Method: SystemNavigation>>browseMyChanges (in category 'browse') -----
  browseMyChanges
  	"Browse only the changes (in the changes file) by the current author."
  
  	"SystemNavigation default browseMyChanges"
  
+ 	^ self browseAllSelect: [ :method |
- 	self browseAllSelect: [ :method |
         method fileIndex > 1 "only look at changes file"
                 and: [ method timeStamp beginsWith: Utilities authorInitials ]]!

Item was changed:
  ----- Method: SystemNavigation>>browseObsoleteMethodReferences (in category 'browse') -----
  browseObsoleteMethodReferences
  	"Open a browser on all referenced behaviors that are obsolete"
  
  	"SystemNavigation default browseObsoleteMethodReferences"
  
  	| list |
  	list := self obsoleteMethodReferences.
+ 	^ self 
- 	self 
  		browseMessageList: list
  		name: 'Method referencing obsoletes'
  		autoSelect: nil!

Item was changed:
  ----- Method: SystemNavigation>>browseObsoleteReferences (in category 'browse') -----
  browseObsoleteReferences  
  	"self new browseObsoleteReferences"
  
  	| references |
  	references := OrderedCollection new.
  	(LookupKey allSubInstances select:
  		[:x | ((x value isKindOf: Behavior) and: ['AnOb*' match: x value name]) or:
  		['AnOb*' match: x value class name]]) 
  		do: [:x | references addAll: (self allCallsOn: x)].
+ 	^ self  
- 	self  
  		browseMessageList: references 
  		name: 'References to Obsolete Classes'!

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."
  	"Time millisecondsToRun: [SystemNavigation default browseUncommentedMethodsWithInitials: 'jm']"
  
+ 	^ self
- 	self
  		browseMessageList: [ self allUncommentedMethodsWithInitials: targetInitials ] 
  		name: 'Uncommented methods with initials ', targetInitials
  		autoSelect: nil!



More information about the Squeak-dev mailing list