The Trunk: Tools-LM.829.mcz

David T. Lewis uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-LM.829.mcz

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

Name: Tools-LM.829
Author: LM
Time: 16 August 2018, 2:01:04.706807 am
UUID: 46879fde-2c09-ca4a-9b63-b14a1e21e4c0
Ancestors: Tools-LM.828

In response to the feedback I received to Tools-LM.828 ( http://forum.world.st/The-Inbox-Tools-LM-828-mcz-td5082873.html ).

I now made the ObjectExplorer only exclude those ObjectExplorerWrappers from the "chase pointers" search that are a submorph of the ActiveWorld.
This is helpful if, for example, one reference to the object in question is held by an ObjectExplorer in another project that you forgot about.

The findDeepSubmorphsIn:that: method should probably be moved into the Morph class, because it is a classic case of feature envy and Morph already contains a findDeepSubmorphThat:ifAbsent: method, which is similar. I just didn't want to mess with one of the core Morphic classes.

I know that the way I find which ObjectExplorerWrappers are visible is not ideal, because it violates the principle of MVC that the model should not know about the implementation specifics of the view. So any feedback and suggestions in that regard would be appreciated.

=============== Diff against Tools-cmm.826 ===============

Item was changed:
  ----- Method: FileContentsBrowser>>browseVersions (in category 'other') -----
  browseVersions
+ "Create and schedule a message set browser on all versions of the
+ currently selected message selector."
+ | class selector |
+ (selector := self selectedMessageName) ifNotNil:
+ [class := self selectedClassOrMetaClass.
+ (class exists and: [class realClass includesSelector: selector]) ifTrue:
+ [VersionsBrowser
+ browseVersionsOf: (class realClass compiledMethodAt: selector)
+ class: class realClass theNonMetaClass
+ meta: class realClass isMeta
+ category: self selectedMessageCategoryName
+ selector: selector]]!
- "Create and schedule a message set browser on all versions of the currently selected message selector."
- (ToolSet
- browseVersionsOf: self selectedClassOrMetaClass
- selector: self selectedMessageName) ifNil: [self changed: #flash]!

Item was changed:
  ----- Method: Inspector>>chasePointers (in category 'menu commands') -----
  chasePointers
  | selected  saved |
  self selectionIndex = 0 ifTrue: [^ self changed: #flash].
  selected := self selection.
  saved := self object.
  [self object: nil.
  (Smalltalk includesKey: #PointerFinder)
  ifTrue: [PointerFinder on: selected]
  ifFalse: [self inspectPointers]]
  ensure: [self object: saved]!

Item was changed:
  ----- Method: ObjectExplorer>>chasePointersForSelection (in category 'menus - actions') -----
  chasePointersForSelection
 
+ PointerFinder on: self object except: self possibleReferencesToSelection!
- self flag: #tooMany. "mt: Note that we might want to ignore references caused by this tool."
- self object chasePointers.!

Item was added:
+ ----- Method: ObjectExplorer>>findDeepSubmorphsIn:that: (in category 'accessing - view') -----
+ findDeepSubmorphsIn: aMorph that: aBlock
+
+ | selectedSubmorphs |
+ selectedSubmorphs := aMorph submorphs select: aBlock.
+ ^ selectedSubmorphs, (aMorph submorphs collect: [:each |
+ self findDeepSubmorphsIn: each that: aBlock]) flatten!

Item was added:
+ ----- Method: ObjectExplorer>>possibleReferencesToSelection (in category 'accessing - view') -----
+ possibleReferencesToSelection
+
+ ^ {self}, self visibleObjectExplorerWrappers!

Item was added:
+ ----- Method: ObjectExplorer>>views (in category 'accessing - view') -----
+ views
+
+ ^ self findDeepSubmorphsIn: ActiveWorld that: [:morph |
+ morph modelOrNil = self]!

Item was added:
+ ----- Method: ObjectExplorer>>visibleListItems (in category 'accessing - view') -----
+ visibleListItems
+
+ | lists |
+ lists := self views select: [:morph |
+ (morph isKindOf: PluggableTreeMorph)].
+ ^ (lists collect: [:each|
+ each items]) flatten!

Item was added:
+ ----- Method: ObjectExplorer>>visibleObjectExplorerWrappers (in category 'accessing - view') -----
+ visibleObjectExplorerWrappers
+
+ | listItems |
+ listItems := self visibleListItems.
+ ^ listItems collect: [:each | each complexContents]!

Item was changed:
  ----- Method: PointerExplorer>>rootObject: (in category 'accessing') -----
  rootObject: anObject
 
+ self root key: 'root'.
- self root key: anObject identityHash asString.
  super rootObject: anObject.!

Item was changed:
  ----- Method: PointerExplorerWrapper>>contents (in category 'accessing') -----
  contents
  "Return the wrappers with the objects holding references to item. Eldest objects come first, weak only referencers are at the end and have parentheses around their identity hash."
 
  | objects weakOnlyReferences |
  objects := self object inboundPointersExcluding: { self. self item. model }.
  weakOnlyReferences := OrderedCollection new.
  objects removeAllSuchThat: [ :each |
  each class == self class
  or: [ each class == PointerExplorer
  or: [ (each isContext
  and: [ (each objectClass: each receiver) == PointerExplorer ] )
  or: [ (each pointsOnlyWeaklyTo: self object)
  ifTrue: [ weakOnlyReferences add: each. true ]
  ifFalse: [ false ] ] ] ] ].
  ^(objects replace: [ :each |
+ self class with: each name: (self nameForParent: each) model: self object ])
- self class with: each name: each identityHash asString model: self object ])
  addAll: (weakOnlyReferences replace: [ :each |
+ (self class with: each name: '(', (self nameForParent: each), ')' model: self object)
- (self class with: each name: '(', each identityHash asString, ')' model: self object)
  weakOnly: true;
  yourself ]);
  yourself!

Item was added:
+ ----- Method: PointerExplorerWrapper>>explorerStringFor: (in category 'converting') -----
+ explorerStringFor: anObject
+
+ ^ anObject identityHash asString, ': ', (super explorerStringFor: anObject).!

Item was added:
+ ----- Method: PointerExplorerWrapper>>memberNameFrom:to: (in category 'accessing') -----
+ memberNameFrom: aParent to: aChild
+
+ 1 to: aParent class instSize do: [ :instVarIndex |
+ (aParent instVarAt: instVarIndex) = aChild
+ ifTrue: [ ^ '#', (aParent class instVarNameForIndex: instVarIndex)]].
+ "This also covers arrays"
+ 1 to: aParent basicSize do: [ :index |
+ (aParent basicAt: index) = aChild
+ ifTrue: [^ index asString]].
+ ^ '???'!

Item was added:
+ ----- Method: PointerExplorerWrapper>>nameForParent: (in category 'accessing') -----
+ nameForParent: anObject
+
+ ^  self memberNameFrom: anObject to: self object!

Item was changed:
  Model subclass: #PointerFinder
+ instanceVariableNames: 'goal parents toDo toDoNext hasGemStone pointerList objectList parentsSize todoSize depth pointerListIndex excludedObjects'
- instanceVariableNames: 'goal parents toDo toDoNext hasGemStone pointerList objectList parentsSize todoSize depth pointerListIndex'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Tools-Debugger'!
 
  !PointerFinder commentStamp: '<historical>' prior: 0!
  I can search for reasons why a certain object isn't garbage collected.  I'm a quick port of a VisualWorks program written by Hans-Martin Mosner.  Call me as shown below.  I'll search for a path from a global variable to the given object, presenting it in a small morphic UI.
 
  Examples:
  PointerFinder on: self currentHand
  PointerFinder on: StandardSystemView someInstance
 
  Now, let's see why this image contains more HandMorphs as expected...
 
  HandMorph allInstancesDo: [:e | PointerFinder on: e]!

Item was added:
+ ----- Method: PointerFinder class>>on:except: (in category 'instance creation') -----
+ on: anObject except: aCollection
+ ^ self new
+ goal: anObject;
+ excludedObjects: aCollection;
+ search;
+ open!

Item was changed:
  ----- Method: PointerFinder>>buildList (in category 'application') -----
  buildList
  | list obj parent object key |
  list := OrderedCollection new.
  obj := goal.
-
  [list addFirst: obj.
  obj := parents at: obj ifAbsent: [].
  obj == nil] whileFalse.
  list removeFirst.
  parent := Smalltalk.
  objectList := OrderedCollection new.
  pointerList := OrderedCollection new.
  [list isEmpty]
  whileFalse:
  [object := list removeFirst.
  key := nil.
  (parent isKindOf: Dictionary)
  ifTrue: [list size >= 2
  ifTrue:
  [key := parent keyAtValue: list second ifAbsent: [].
  key == nil
  ifFalse:
  [object := list removeFirst; removeFirst.
  pointerList add: key printString , ' -> ' , object class name]]].
  key == nil
  ifTrue:
  [parent class == object ifTrue: [key := 'CLASS'].
  key == nil ifTrue: [1 to: parent class instSize do: [:i | key == nil ifTrue: [(parent instVarAt: i)
  == object ifTrue: [key := parent class instVarNameForIndex: i]]]].
  key == nil ifTrue: [parent isCompiledCode ifTrue: [key := 'literals?']].
  key == nil ifTrue: [1 to: parent basicSize do: [:i | key == nil ifTrue: [(parent basicAt: i)
  == object ifTrue: [key := i printString]]]].
  key == nil ifTrue: [(parent isMorph and: [object isKindOf: Array]) ifTrue: [key := 'submorphs?']].
  key == nil ifTrue: [key := '???'].
  pointerList add: key , ': ' , object class name, (object isMorph ifTrue: [' (', object identityHash asString, ')'] ifFalse: [ String empty ]) ].
  objectList add: object.
  parent := object]!

Item was added:
+ ----- Method: PointerFinder>>excludedObjects (in category 'accessing') -----
+ excludedObjects
+
+ ^ excludedObjects ifNil: [excludedObjects := OrderedCollection new]!

Item was added:
+ ----- Method: PointerFinder>>excludedObjects: (in category 'accessing') -----
+ excludedObjects: aCollection
+
+ excludedObjects := aCollection!

Item was changed:
  ----- Method: PointerFinder>>followObject: (in category 'application') -----
  followObject: anObject
+
+ (self excludedObjects includes: anObject)
+ ifTrue: [^ false].
  anObject outboundPointersDo: [:ea |
  (self follow: ea from: anObject)
  ifTrue: [^ true]].
  ^ false!

Item was changed:
  ----- Method: PointerFinder>>initialize (in category 'application') -----
  initialize
  parents := IdentityDictionary new: 20000.
  parents at: Smalltalk put: nil.
  parents at: Processor put: nil.
  parents at: self put: nil.
 
  toDo := OrderedCollection new: 5000.
  toDo add: Smalltalk.
+ toDoNext := OrderedCollection new: 5000.!
- toDoNext := OrderedCollection new: 5000!