The Trunk: Tools-mt.542.mcz

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

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

Name: Tools-mt.542
Author: mt
Time: 7 March 2015, 12:19:04.957 pm
UUID: 2474c709-2040-f040-99eb-6144e9acd707
Ancestors: Tools-mt.541

Object explorer now uses tool builder. Includes code clean-up and some fixes. Monitoring entries works again.

=============== Diff against Tools-mt.541 ===============

Item was added:
+ ----- Method: IndentingListItemMorph>>refresh (in category 'initialization') -----
+ refresh
+
+ self contents: complexContents asString.
+ icon := complexContents icon.!

Item was changed:
  AbstractHierarchicalList subclass: #ObjectExplorer
+ instanceVariableNames: 'root currentParent inspector monitorList'
- instanceVariableNames: 'rootObject inspector monitorList'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Tools-Explorer'!
 
  !ObjectExplorer commentStamp: '<historical>' prior: 0!
  ObjectExplorer provides a hierarchical alternative to #inspect. Simply evaluate an expression like:
 
  World explore
 
  and enjoy.!

Item was added:
+ ----- Method: ObjectExplorer class>>nodeClass (in category 'as yet unclassified') -----
+ nodeClass
+
+ ^ ObjectExplorerWrapper!

Item was added:
+ ----- Method: ObjectExplorer>>buildWith: (in category 'toolbuilder') -----
+ buildWith: builder
+
+ | windowSpec treeSpec textSpec |
+ windowSpec := builder pluggableWindowSpec new.
+ windowSpec
+ model: self;
+ children: OrderedCollection new;
+ label: #label.
+
+ treeSpec := builder pluggableTreeSpec new.
+ treeSpec
+ model: self;
+ nodeClass: self class nodeClass;
+ roots: #getList;
+ keyPress: #explorerKey:from:;
+ getSelected: #currentSelection;
+ setSelected: #currentSelection:;
+ setSelectedParent: #currentParent:;
+ menu: #genericMenu:;
+ autoDeselect: false;
+ columns: (ObjectExplorerWrapper showContentsInColumns
+ ifTrue: [{
+ [:listMorph | (listMorph scroller submorphs collect: [:item |
+ item preferredWidthOfColumn: 1]) max].
+ nil "take all the space"}]
+ ifFalse: []);
+ frame: (0@0 corner: 1@0.85).
+ windowSpec children add: treeSpec.
+
+ textSpec := builder pluggableTextSpec new.
+ textSpec
+ model: self;
+ menu: #codePaneMenu:shifted:;
+ frame: (0@0.85 corner: 1@1).
+ windowSpec children add: textSpec.
+
+ ^ builder build: windowSpec!

Item was changed:
+ ----- Method: ObjectExplorer>>chasePointers (in category 'menus - callbacks') -----
- ----- Method: ObjectExplorer>>chasePointers (in category 'menus') -----
  chasePointers
  "Open a PointerFinder on the selected item"
  | path sel savedRoot saved |
  path := OrderedCollection new.
  sel := currentSelection.
  [ sel isNil ] whileFalse: [ path addFirst: sel asString. sel := sel parent ].
  path addFirst: #openPath.
  path := path asArray.
  savedRoot := rootObject.
  saved := self object.
  [ rootObject := nil.
  self changed: #getList.
  (Smalltalk includesKey: #PointerFinder)
  ifTrue: [PointerFinder on: saved]
  ifFalse: [self objectReferencesToSelection ]]
  ensure: [ rootObject := savedRoot.
  self changed: #getList.
  self changed: path.
  ]!

Item was removed:
- ----- Method: ObjectExplorer>>contentsSelection (in category 'accessing') -----
- contentsSelection
- "Return the interval of text in the code pane to select when I set the pane's contents"
-
- ^ 1 to: 0  "null selection"!

Item was added:
+ ----- Method: ObjectExplorer>>currentParent (in category 'accessing') -----
+ currentParent
+ ^ currentParent!

Item was added:
+ ----- Method: ObjectExplorer>>currentParent: (in category 'accessing') -----
+ currentParent: anObject
+ currentParent := anObject.!

Item was added:
+ ----- Method: ObjectExplorer>>currentSelection (in category 'accessing') -----
+ currentSelection
+
+ ^ currentSelection!

Item was added:
+ ----- Method: ObjectExplorer>>currentSelection: (in category 'accessing') -----
+ currentSelection: anObject
+
+ self currentSelection == anObject ifTrue: [^ self].
+ currentSelection := anObject.
+ self changed: #currentSelection.!

Item was changed:
+ ----- Method: ObjectExplorer>>defsOfSelection (in category 'menus - callbacks') -----
- ----- Method: ObjectExplorer>>defsOfSelection (in category 'menus') -----
  defsOfSelection
  "Open a browser on all defining references to the selected instance variable, if that's what's currently selected."
  | aClass sel |
 
  (aClass := self parentObject class) isVariable ifTrue: [^ self changed: #flash].
  sel := self selector.
  self systemNavigation  browseAllStoresInto: sel from: aClass!

Item was changed:
  ----- Method: ObjectExplorer>>doItReceiver (in category 'accessing') -----
  doItReceiver
  "Answer the object that should be informed of the result of evaluating a
  text selection."
 
+ ^ self object!
- currentSelection ifNil: [^rootObject].
- ^currentSelection withoutListWrapper
- !

Item was changed:
+ ----- Method: ObjectExplorer>>explorePointers (in category 'menus - callbacks') -----
- ----- Method: ObjectExplorer>>explorePointers (in category 'menus') -----
  explorePointers
  "Open a PointerExplorer on the current selection"
  PointerExplorer new openExplorerFor: self object!

Item was changed:
+ ----- Method: ObjectExplorer>>exploreSelection (in category 'menus - callbacks') -----
- ----- Method: ObjectExplorer>>exploreSelection (in category 'menus') -----
  exploreSelection
  "Open an ObjectExplorer on the current selection"
  self object explore!

Item was removed:
- ----- Method: ObjectExplorer>>explorerFor: (in category 'user interface') -----
- explorerFor: anObject
- | window view |
- rootObject := anObject.
- window := (SystemWindow labelled: self label) model: self.
- window addMorph: (view := (SimpleHierarchicalListMorph
- on: self
- list: #getList
- selected: #getCurrentSelection
- changeSelected: #noteNewSelection:
- menu: #genericMenu:
- keystroke: #explorerKey:from:)
- columns: (ObjectExplorerWrapper showContentsInColumns
- ifTrue: [{
- [:listMorph | (listMorph scroller submorphs collect: [:item |
- item preferredWidthOfColumn: 1]) max].
- nil "take all the space"}]
- ifFalse: []);
- yourself)
- frame: (0@0 corner: 1@0.8).
- window addMorph: ((PluggableTextMorph on: self text: #trash accept: #trash:
- readSelection: #contentsSelection menu: #codePaneMenu:shifted:)
- askBeforeDiscardingEdits: false)
- frame: (0@0.8 corner: 1@1).
- view
- autoDeselect: false.
-      ^ window!

Item was removed:
- ----- Method: ObjectExplorer>>explorerFor:withLabel: (in category 'user interface') -----
- explorerFor: anObject withLabel: label
- | window view |
- rootObject := anObject.
- window := (SystemWindow labelled: label)
- model: self.
-
- window
- addMorph: (view := (SimpleHierarchicalListMorph
- on: self
- list: #getList
- selected: #getCurrentSelection
- changeSelected: #noteNewSelection:
- menu: #genericMenu:
- keystroke: nil)
- columns: (ObjectExplorerWrapper showContentsInColumns
- ifTrue: [{
- [:listMorph | (listMorph scroller submorphs collect: [:item |
- item preferredWidthOfColumn: 1]) max].
- nil "take all the space"}]
- ifFalse: []);
- yourself)
- frame: (0 @ 0 corner: 1 @ 0.8).
- window
- addMorph: ((PluggableTextMorph
- on: self
- text: #trash
- accept: #trash:
- readSelection: #contentsSelection
- menu: #codePaneMenu:shifted:)
- askBeforeDiscardingEdits: false)
- frame: (0 @ 0.8 corner: 1 @ 1).
- view autoDeselect: false.
- ^ window!

Item was changed:
  ----- Method: ObjectExplorer>>explorerKey:from: (in category 'menus') -----
  explorerKey: aChar from: view
 
  "Similar to #genericMenu:..."
  | insideObject parentObject |
  currentSelection ifNotNil: [
  insideObject := self object.
  parentObject := self parentObject.
  inspector ifNil: [inspector := Inspector new].
  inspector
  inspect: parentObject;
  object: insideObject.
 
  aChar == $i ifTrue: [^ self inspectSelection].
  aChar == $I ifTrue: [^ self exploreSelection].
 
  aChar == $b ifTrue: [^ inspector browseMethodFull].
  aChar == $h ifTrue: [^ inspector classHierarchy].
+ aChar == $c ifTrue: [^ Clipboard clipboardText: self currentSelection key].
- aChar == $c ifTrue: [^ inspector copyName].
  aChar == $p ifTrue: [^ inspector browseFullProtocol].
  aChar == $N ifTrue: [^ inspector browseClassRefs].
  aChar == $t ifTrue: [^ inspector tearOffTile].
  aChar == $v ifTrue: [^ inspector viewerForValue]].
 
  ^ self arrowKey: aChar from: view!

Item was changed:
  ----- Method: ObjectExplorer>>getList (in category 'accessing') -----
  getList
+ "This explorer shows bindings in a tree structure. Create the root binding here."
+
+ ^ {self root}!
-
- ^Array with: (ObjectExplorerWrapper with: rootObject name: 'root' model: self parent: nil)
- !

Item was changed:
  ----- Method: ObjectExplorer>>initialExtent (in category 'user interface') -----
  initialExtent
 
+ ^400@400!
- ^300@500!

Item was changed:
+ ----- Method: ObjectExplorer>>inspectSelection (in category 'menus - callbacks') -----
- ----- Method: ObjectExplorer>>inspectSelection (in category 'menus') -----
  inspectSelection
  "Open an Inspector on the current selection"
  self object inspect!

Item was changed:
  ----- Method: ObjectExplorer>>label (in category 'accessing') -----
  label
 
+ ^ self rootObject printStringLimitedTo: 32!
- ^ rootObject printStringLimitedTo: 32!

Item was changed:
+ ----- Method: ObjectExplorer>>monitor: (in category 'menus - callbacks') -----
+ monitor: aBinding
+ "Start stepping and watching the given binding for changes."
+
+ aBinding ifNil: [ ^self ].
- ----- Method: ObjectExplorer>>monitor: (in category 'monitoring') -----
- monitor: anObjectExplorerWrapper
- "Start stepping and watching the given wrapper for changes."
- anObjectExplorerWrapper ifNil: [ ^self ].
  self world ifNil: [ ^self ].
+ self monitorList add: aBinding.
+
+ self world startStepping: self at: Time millisecondClockValue selector: #step arguments: #() stepTime: 2000.!
- self monitorList at: anObjectExplorerWrapper put: anObjectExplorerWrapper asString.
- self world startStepping: self at: Time millisecondClockValue selector: #step arguments: #() stepTime: 200.!

Item was changed:
  ----- Method: ObjectExplorer>>monitorList (in category 'monitoring') -----
  monitorList
+ ^monitorList ifNil: [ monitorList := WeakOrderedCollection new ].!
- ^monitorList ifNil: [ monitorList := WeakIdentityKeyDictionary new ].!

Item was changed:
+ ----- Method: ObjectExplorer>>object (in category 'accessing - objects') -----
- ----- Method: ObjectExplorer>>object (in category 'accessing') -----
  object
+
+ ^ self currentSelection value!
- ^currentSelection ifNotNil: [ :cs | cs withoutListWrapper ]!

Item was changed:
+ ----- Method: ObjectExplorer>>objectReferencesToSelection (in category 'menus - callbacks') -----
- ----- Method: ObjectExplorer>>objectReferencesToSelection (in category 'menus') -----
  objectReferencesToSelection
  "Open a browser on all references to the selected instance variable, if that's what currently selected. "
  self systemNavigation
  browseAllObjectReferencesTo: self object
  except: (Array with: self parentObject with: currentSelection with: inspector)
  ifNone: [:obj | self changed: #flash].
  !

Item was removed:
- ----- Method: ObjectExplorer>>openBrowser: (in category 'user interface') -----
- openBrowser: aClass
-
- ^ToolSet browseClass: aClass!

Item was changed:
  ----- Method: ObjectExplorer>>openExplorerFor: (in category 'user interface') -----
  openExplorerFor: anObject
+ "ObjectExplorer new openExplorerFor: Smalltalk."
- "
- ObjectExplorer new openExplorerFor: Smalltalk
- "
 
+ ^ self openExplorerFor: anObject withLabel: nil!
- | win |
- win := (self explorerFor: anObject) openInWorld.
- Cursor wait showWhile:
- [win submorphs do:
- [:sm|
- (sm respondsTo: #expandRoots) ifTrue:
- [sm expandRoots]]].
- ^self
- !

Item was changed:
  ----- Method: ObjectExplorer>>openExplorerFor:withLabel: (in category 'user interface') -----
  openExplorerFor: anObject withLabel: label
       "ObjectExplorer new openExplorerFor: Smalltalk withLabel: 'Smalltalk'"
 
+ ToolBuilder open: self label: label.
+ self rootObject: anObject.!
- (self explorerFor: anObject withLabel: label)
- openInWorld!

Item was changed:
+ ----- Method: ObjectExplorer>>parentObject (in category 'accessing - objects') -----
- ----- Method: ObjectExplorer>>parentObject (in category 'accessing') -----
  parentObject
+
+ ^ self currentParent value!
- currentSelection ifNil: [ ^nil ].
- currentSelection parent ifNil: [ ^rootObject ].
- ^currentSelection parent withoutListWrapper!

Item was changed:
+ ----- Method: ObjectExplorer>>referencesToSelection (in category 'menus - callbacks') -----
- ----- Method: ObjectExplorer>>referencesToSelection (in category 'menus') -----
  referencesToSelection
  "Open a browser on all references to the selected instance variable, if that's what's currently selected."
  | aClass sel |
 
  (aClass := self parentObject class) isVariable ifTrue: [^ self changed: #flash].
  sel := self selector.
  self systemNavigation browseAllAccessesTo: sel from: aClass!

Item was added:
+ ----- Method: ObjectExplorer>>root (in category 'accessing') -----
+ root
+
+ ^ root ifNil: [root := 'root' -> nil]!

Item was changed:
+ ----- Method: ObjectExplorer>>rootObject (in category 'accessing - objects') -----
- ----- Method: ObjectExplorer>>rootObject (in category 'accessing') -----
  rootObject
+
+ ^ self root value!
- ^ rootObject!

Item was added:
+ ----- Method: ObjectExplorer>>rootObject: (in category 'accessing - objects') -----
+ rootObject: anObject
+
+ self root value: anObject.
+
+ self changed: #label.
+ self changed: #getList.
+ self changed: #expandRootsRequested.
+
+ self currentSelection: self getList first.!

Item was changed:
+ ----- Method: ObjectExplorer>>selectedClass (in category 'accessing - other') -----
- ----- Method: ObjectExplorer>>selectedClass (in category 'menus') -----
  selectedClass
  "Answer the class of the receiver's current selection"
 
  ^self doItReceiver class
  !

Item was changed:
+ ----- Method: ObjectExplorer>>selector (in category 'accessing - other') -----
- ----- Method: ObjectExplorer>>selector (in category 'accessing') -----
  selector
+
+ self flag: #deprecated. "mt: Who uses this? And why?"
+ self parentObject ifNil: [^ nil].
+ (self parentObject class allInstVarNames includes: self currentSelection key)
+ ifTrue: [^ self currentSelection key asSymbol].
+ ^ nil!
- ^currentSelection ifNotNil: [ :cs | cs selector ]!

Item was changed:
  ----- Method: ObjectExplorer>>step (in category 'monitoring') -----
  step
+ "Let all views know that some of my objects need to be updated."
+
+ self monitorList do: [ :object |
+ object ifNotNil: [self changed: #objectChanged with: object]].
+ self monitorList ifEmpty: [
+ ActiveWorld stopStepping: self selector: #step ].!
- "If there's anything in my monitor list, see if the strings have changed."
- | changes |
- changes := false.
- self monitorList keysAndValuesDo: [ :k :v |
- k ifNotNil: [
- | string |
- k refresh.
- (string := k asString) ~= v ifTrue: [ self monitorList at: k put: string. changes := true ].
- ]
- ].
- changes ifTrue: [ | sel |
- sel := currentSelection.
- self changed: #getList.
- self noteNewSelection: sel.
- ].
- self monitorList isEmpty ifTrue: [ ActiveWorld stopStepping: self selector: #step ].!

Item was removed:
- ----- Method: ObjectExplorer>>trash (in category 'menus') -----
- trash
- "What goes in the bottom pane"
- ^ ''!

Item was removed:
- ----- Method: ObjectExplorer>>trash: (in category 'menus') -----
- trash: newText
- "Don't save it"
- ^ true!

Item was added:
+ ----- Method: PointerExplorer class>>nodeClass (in category 'as yet unclassified') -----
+ nodeClass
+
+ ^ PointerExplorerWrapper!

Item was removed:
- ----- Method: PointerExplorer>>getList (in category 'accessing') -----
- getList
- ^Array with: (PointerExplorerWrapper with: rootObject name: rootObject identityHash asString model: self)
- !

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