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.!
squeak-dev@lists.squeakfoundation.org