The Trunk: System-mt.1078.mcz

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!