The Inbox: Tools-mt.536.mcz

Marcel Taeumel uploaded a new version of Tools to project The Inbox:
http://source.squeak.org/inbox/Tools-mt.536.mcz

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

Name: Tools-mt.536
Author: mt
Time: 1 March 2015, 9:35:39.627 pm
UUID: 1ab7460c-c7be-f647-a881-9bca8ab6e605
Ancestors: Tools-mt.535

NEW TOOL: Object Collection Tool

Drag and drop classes or methods from the browser into it to open mini-editors in a list. Dropping morphs will open an object explorer for that morph.

ObjectCollectionTool open.

=============== Diff against Tools-mt.535 ===============

Item was added:
+ Morph subclass: #ObjectCollectionItem
+ instanceVariableNames: 'object'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Tools-Browser'!

Item was added:
+ ----- Method: ObjectCollectionItem class>>on:object: (in category 'instance creation') -----
+ on: aMorph object: anObject
+
+ aMorph
+ hResizing: #spaceFill;
+ vResizing: #spaceFill.
+
+ ^ self new
+ object: anObject;
+ addMorphFront: aMorph;
+ yourself!

Item was added:
+ ----- Method: ObjectCollectionItem>>fastFramingOn (in category 'compatibility') -----
+ fastFramingOn
+ "Compatibility with system window interface. Needed by grip morphs."
+
+ ^ false!

Item was added:
+ ----- Method: ObjectCollectionItem>>initialize (in category 'initialization') -----
+ initialize
+
+ super initialize.
+ self
+ height: 200;
+ color: Color transparent;
+ layoutPolicy: TableLayout new;
+ listDirection: #topToBottom;
+ hResizing: #spaceFill;
+ vResizing: #rigid.
+
+ self addMorph: (BottomGripMorph new target: self).!

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

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

Item was added:
+ Morph subclass: #ObjectCollectionPane
+ instanceVariableNames: 'model'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Tools-Browser'!

Item was added:
+ ----- Method: ObjectCollectionPane>>acceptDroppingMorph:event: (in category 'drag and drop') -----
+ acceptDroppingMorph: aMorph event: evt
+
+ self model
+ acceptDroppingMorph: aMorph
+ event: evt
+ inMorph: self.!

Item was added:
+ ----- Method: ObjectCollectionPane>>adoptPaneColor: (in category 'accessing') -----
+ adoptPaneColor: c
+
+ self
+ color: c;
+ borderColor: c darker darker.
+
+ super adoptPaneColor: c.!

Item was added:
+ ----- Method: ObjectCollectionPane>>drawOn: (in category 'initialization') -----
+ drawOn: aCanvas
+
+ super drawOn: aCanvas.
+
+ ('Drop objects here or in-between. Close editors with CMD+W.' asText
+ addAttribute: (TextColor color: self borderStyle color darker);
+ asMorph)
+ center: (self center x @ (self bottom - 10));
+ drawOn: aCanvas.!

Item was added:
+ ----- Method: ObjectCollectionPane>>initialize (in category 'initialization') -----
+ initialize
+
+ super initialize.
+ self
+ height: 200;
+ layoutPolicy: TableLayout new;
+ layoutInset: (0@0 corner: 0@25);
+ listDirection: #topToBottom;
+ hResizing: #spaceFill;
+ vResizing: #shrinkWrap;
+ dropEnabled: true.!

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

Item was added:
+ ----- Method: ObjectCollectionPane>>model: (in category 'accessing') -----
+ model: anObjectCollectionTool
+
+ model := anObjectCollectionTool.!

Item was added:
+ ----- Method: ObjectCollectionPane>>removedMorph: (in category 'submorphs-add/remove') -----
+ removedMorph: anItem
+
+ self model removeObject: anItem object.!

Item was added:
+ ----- Method: ObjectCollectionPane>>submorphAt: (in category 'submorphs-accessing') -----
+ submorphAt: position
+
+ ^ (self morphsAt: position)
+ detect: [:m | self submorphs includes: m]
+ ifNone: []!

Item was added:
+ ----- Method: ObjectCollectionPane>>wantsDroppedMorph:event: (in category 'drag and drop') -----
+ wantsDroppedMorph: aMorph event: evt
+
+ ^ self model
+ wantsDroppedMorph: aMorph
+ event: evt
+ inMorph: self!

Item was added:
+ Model subclass: #ObjectCollectionTool
+ instanceVariableNames: 'objects'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Tools-Browser'!

Item was added:
+ ----- Method: ObjectCollectionTool class>>open (in category 'instance creation') -----
+ open
+
+ ^ (ToolBuilder open: self new) model!

Item was added:
+ ----- Method: ObjectCollectionTool class>>windowColorSpecification (in category 'instance creation') -----
+ windowColorSpecification
+ "WindowColorRegistry refresh."
+
+ ^ WindowColorSpec
+ classSymbol: self name
+ wording: 'Object Collection Tool'
+ brightColor: #lightGreen
+ pastelColor: #paleGreen
+ helpMessage: ''!

Item was added:
+ ----- Method: ObjectCollectionTool>>acceptDroppingMorph:event:inMorph: (in category 'drag and drop') -----
+ acceptDroppingMorph: transferMorph event: dropEvent inMorph: collectionPane
+
+ | object |
+ object := (transferMorph respondsTo: #passenger)
+ ifTrue: [transferMorph passenger]
+ ifFalse: [transferMorph].
+ self
+ buildWidgetFor: object
+ then: [:widget |
+ (ObjectCollectionItem on: widget object: object) in: [:newItem |
+ (collectionPane submorphAt: dropEvent position)
+ ifNil: [collectionPane addMorphBack: newItem]
+ ifNotNil: [:m |
+ dropEvent position y < m center y
+ ifTrue: [collectionPane addMorph: newItem inFrontOf: m]
+ ifFalse: [collectionPane addMorph: newItem behind: m]] ].
+ self addObject: object].
+
+ .!

Item was added:
+ ----- Method: ObjectCollectionTool>>addObject: (in category 'accessing - objects') -----
+ addObject: anObject
+
+ self objects add: anObject.
+ self changed: #labelString !

Item was added:
+ ----- Method: ObjectCollectionTool>>buildWidgetFor:then: (in category 'widgets') -----
+ buildWidgetFor: anObject then: actionBlock
+
+ (anObject isKindOf: CompiledMethod)
+ ifTrue: [^ self buildWidgetForCompiledMethod: anObject then: actionBlock].
+ (anObject isKindOf: ClassDescription)
+ ifTrue: [^ self buildWidgetForClassDescription: anObject then: actionBlock].
+
+ self buildWidgetForObject: anObject then: actionBlock.!

Item was added:
+ ----- Method: ObjectCollectionTool>>buildWidgetForClassDescription:then: (in category 'widgets') -----
+ buildWidgetForClassDescription: cls then: actionBlock
+
+ | builder spec menu |
+ menu := MenuMorph new
+ defaultTarget: [:symbol |
+ builder := ToolBuilder default.
+ spec := Browser new
+ selectSystemCategory: cls category;
+ selectClass: cls;
+ metaClassIndicated: (symbol = #meta);
+ editSelection: #editClass;
+ buildCodePaneWith: builder.
+ actionBlock value: (builder build: spec)];
+
+ add: cls theNonMetaClass name selector: #value: argument: #nonMeta;
+ add: cls theMetaClass name selector: #value: argument: #meta;
+ popUpAt: self currentEvent position forHand: self currentHand in: self currentWorld.
+
+ "We need to trick the window, which will overlap the menu here."
+ Project current addDeferredUIMessage:[menu comeToFront].!

Item was added:
+ ----- Method: ObjectCollectionTool>>buildWidgetForCompiledMethod:then: (in category 'widgets') -----
+ buildWidgetForCompiledMethod: method then: actionBlock
+
+ | builder spec |
+ builder := ToolBuilder default.
+ spec := Browser new
+ selectSystemCategory: method methodClass category;
+ selectClass: method methodClass;
+ metaClassIndicated: method methodClass isMeta;
+ selectMessageNamed: method selector;
+ editSelection: #editMessage;
+ buildCodePaneWith: builder.
+
+ "MethodHolder new
+ methodClass: method methodClass methodSelector: method selector;
+ buildCodePaneWith: builder."
+
+ actionBlock value: (builder build: spec).!

Item was added:
+ ----- Method: ObjectCollectionTool>>buildWidgetForObject:then: (in category 'widgets') -----
+ buildWidgetForObject: anObject then: actionBlock
+ "Fall-back if nothing more special can be found."
+
+ actionBlock value: (
+ "Get rid of the system window."
+ Morph new
+ changeProportionalLayout;
+ color: Color transparent;
+ addAllMorphs: (ObjectExplorer new explorerFor: Morph new) paneMorphs;
+ yourself).
+ !

Item was added:
+ ----- Method: ObjectCollectionTool>>buildWith: (in category 'toolbuilder') -----
+ buildWith: builder
+
+ | windowSpec scrollSpec morph |
+ windowSpec := builder pluggableWindowSpec new.
+ windowSpec
+ model: self;
+ label: #labelString;
+ children: OrderedCollection new.
+
+ scrollSpec := builder pluggableScrollPaneSpec new.
+ scrollSpec
+ name: #scrollPane;
+ model: self;
+ hScrollBarPolicy: #never;
+ vScrollBarPolicy: #whenNeeded;
+ borderWidth: 0;
+ morph: (ObjectCollectionPane new
+ model: self;
+ yourself);
+ frame: (0@0 corner: 1@1).
+ windowSpec children add: scrollSpec.
+
+ morph := builder build: windowSpec.
+
+ "Set the layout policy for the transform morph."
+ (builder widgetAt: #scrollPane) scroller
+ layoutPolicy: TableLayout new;
+ color: morph paneColor darker darker.
+ (builder widgetAt: #scrollPane) morph
+ color: morph paneColor.
+ ActiveHand addKeyboardListener: self.
+
+ ^ morph!

Item was added:
+ ----- Method: ObjectCollectionTool>>defaultBackgroundColor (in category 'user interface') -----
+ defaultBackgroundColor
+
+ self flag: #refactor. "mt: Does not use the preference mechansim."
+ ^ Color colorFrom: self class windowColorSpecification brightColor!

Item was added:
+ ----- Method: ObjectCollectionTool>>handleListenEvent: (in category 'events-processing') -----
+ handleListenEvent: anEvent
+
+ "Has something keyboard focus at all?"
+ anEvent hand keyboardFocus ifNil: [^ self].
+
+ "CMD+W?"
+ ((anEvent isKeystroke
+ and: [anEvent commandKeyPressed])
+ and: [anEvent keyCharacter = $w])
+ ifFalse: [^ self].
+
+ "Has keyboard?"
+ (anEvent hand keyboardFocus firstOwnerSuchThat: [:m |
+ m isSystemWindow and: [m model == self]])
+ ifNil: [^ self].
+
+ "Which item is it?"
+ (anEvent hand keyboardFocus firstOwnerSuchThat: [:m |
+ m owner class = ObjectCollectionPane]) delete.!

Item was added:
+ ----- Method: ObjectCollectionTool>>labelString (in category 'user interface') -----
+ labelString
+
+ ^ 'Object Collection Tool ({1})' format: {self objects size}!

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

Item was added:
+ ----- Method: ObjectCollectionTool>>removeObject: (in category 'accessing - objects') -----
+ removeObject: anObject
+
+ self objects remove: anObject.
+ self changed: #labelString !

Item was added:
+ ----- Method: ObjectCollectionTool>>wantsDroppedMorph:event:inMorph: (in category 'drag and drop') -----
+ wantsDroppedMorph: transferMorph event: dropEvent inMorph: collectionPane
+
+ ^ collectionPane dropEnabled!

Item was added:
+ ----- Method: ObjectCollectionTool>>windowIsClosing (in category 'updating') -----
+ windowIsClosing
+
+ ActiveHand removeKeyboardListener: self.!

For such a tool to be more effective, we need to provide more drag operations in other tools such as:

- Object Explorer
- Senders/Implementors Browser
- Versions Browser

If you want to get rid of the button bars and annotation panes, just disable them in the preferences. Due to code reuse, those are the same as for regular browsers.

Do we want such a tool in the trunk?

Best,
Marcel

On 01.03.2015, at 21:31, Marcel Taeumel <[hidden email]> wrote:

> <http://forum.world.st/file/n4808732/object-collection-tool.png>
>
> For such a tool to be more effective, we need to provide more drag
> operations in other tools such as:
>
> - Object Explorer
> - Senders/Implementors Browser
> - Versions Browser

Also, drag-and-drop for message categories would help sorting ;D

Best
        -Tobias

>
> If you want to get rid of the button bars and annotation panes, just disable
> them in the preferences. Due to code reuse, those are the same as for
> regular browsers.
>
> Do we want such a tool in the trunk?

cool!


>
> Best,
> Marcel

Neat.

> For such a tool to be more effective, we need to provide more drag
> operations in other tools such as:
>
> - Object Explorer
> - Senders/Implementors Browser
> - Versions Browser

You know with this drag-and-drop you could be on to something which
has been been itching me for a long time.  A Behavior Browser.
Imagine a normal HierarchyBrowser window but dedicated to a particular
*object* of that class -- so that when you select a method, in the
upper-right corner of the code-pane is a little button which will run
that method.  Clicking that button runs the method and displays a
little "result-icon" (maybe just the letter "R") next to the button.
The "R" (result-icon) encapsulates the return-value from running the
method and provides a context menu to inspect, explore or open into
its _own_ behavior browser.  The printString could also be displayed
in the code pane (temporarily until another method is selected).

Finally, when a keyword message is selected in the behavior browser,
Drop-Targets representing the arguments are provided.  The button to
run the method cannot be clicked until the user has dragged from the
"R" result-icons (e.g., from other browsers) into those *input*
Drop-Targets of that keyword message.

I feel this is the browser that is "missing" from Smalltalk-80 since
the beginning..

> If you want to get rid of the button bars and annotation panes, just disable
> them in the preferences. Due to code reuse, those are the same as for
> regular browsers.
>
> Do we want such a tool in the trunk?

Looks neat, very possibly.  So, the power this brings the user is the
ability to bring together any heterogeneous collection of objects,
methods, Morphs(?), into a Object Collection Tool (OCT) window.  I
assume it does not save and load into other images so this is meant as
a temporary "working organization" of objects and behaviors is that
right?

For example, I might want to open a OCT window, drag some objects and
related methods into it, and then be able to make some code changes to
the methods while observing the inspected results right there in the
same OCT.  Is this how it should be used or another way?

Thanks.

PS -- when I dragged a variable from an inspector I'm getting a Morph
instead of the object.

PPS -- What do you think of the Behavior Browser idea?

Hi Chris,

thank you, I fixed that bug with "Morph new". :)

The idea with the Behavior Browser sounds interesting. Should not be that difficult to prototype.

Best,
Marcel