The Trunk: ToolBuilder-Morphic-mt.151.mcz

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

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

Name: ToolBuilder-Morphic-mt.151
Author: mt
Time: 4 November 2015, 6:51:17.408 pm
UUID: 047b0821-03ce-4921-bc87-6e2e8b216fe6
Ancestors: ToolBuilder-Morphic-mt.150

Refactors and cleans-up drag-and-drop mechanism used by pluggable lists and trees.

=============== Diff against ToolBuilder-Morphic-mt.150 ===============

Item was changed:
  ----- Method: MorphicToolBuilder>>buildPluggableList: (in category 'widgets required') -----
  buildPluggableList: aSpec
  | widget listClass getIndex setIndex |
  aSpec getSelected ifNil:[
  listClass := self listClass.
  getIndex := aSpec getIndex.
  setIndex := aSpec setIndex.
  ] ifNotNil:[
  listClass := self listByItemClass.
  getIndex := aSpec getSelected.
  setIndex := aSpec setSelected.
  ].
  widget := listClass on: aSpec model
  list: aSpec list
  selected: getIndex
  changeSelected: setIndex
  menu: aSpec menu
  keystroke: aSpec keyPress.
  self register: widget id: aSpec name.
 
  "Override default scroll bar policies if needed. Widget will use preference values otherwise."
  aSpec hScrollBarPolicy ifNotNil: [:policy |
  policy caseOf: {
  [#always] -> [widget alwaysShowHScrollBar].
  [#never] -> [widget hideHScrollBarIndefinitely].
  [#whenNeeded] -> [widget showHScrollBarOnlyWhenNeeded]. } ].
  aSpec vScrollBarPolicy ifNotNil: [:policy |
  policy caseOf: {
  [#always] -> [widget alwaysShowVScrollBar].
  [#never] -> [widget hideVScrollBarIndefinitely].
  [#whenNeeded] -> [widget showVScrollBarOnlyWhenNeeded]. } ].
 
  widget getListElementSelector: aSpec listItem.
  widget getListSizeSelector: aSpec listSize.
  widget getIconSelector: aSpec icon.
  widget getHelpSelector: aSpec help.
  widget doubleClickSelector: aSpec doubleClick.
 
  widget dragItemSelector: aSpec dragItem.
  widget dropItemSelector: aSpec dropItem.
  widget wantsDropSelector: aSpec dropAccept.
+ widget dragStartedSelector: aSpec dragStarted.
 
  widget autoDeselect: aSpec autoDeselect.
  widget keystrokePreviewSelector: aSpec keystrokePreview.
 
  widget
  borderWidth: 1;
  borderColor: Color lightGray;
  color: (aSpec color
  ifNil: [Color white]
  ifNotNil: [aSpec color]).
 
  self setFrame: aSpec frame in: widget.
  self setLayoutHintsFor: widget spec: aSpec.
 
  parent ifNotNil:[self add: widget to: parent].
  panes ifNotNil:[
  aSpec list ifNotNil:[panes add: aSpec list].
  ].
  ^widget!

Item was changed:
  ----- Method: MorphicToolBuilder>>buildPluggableTree: (in category 'widgets required') -----
  buildPluggableTree: aSpec
  | widget |
  widget := self treeClass new.
  self register: widget id: aSpec name.
  widget model: aSpec model.
  widget getSelectedPathSelector: aSpec getSelectedPath.
  widget setSelectedSelector: aSpec setSelected.
  widget getSelectedSelector: aSpec getSelected.
  widget setSelectedParentSelector: aSpec setSelectedParent.
  widget getChildrenSelector: aSpec getChildren.
  widget hasChildrenSelector: aSpec hasChildren.
  widget getLabelSelector: aSpec label.
  widget getIconSelector: aSpec icon.
  widget getHelpSelector: aSpec help.
  widget getMenuSelector: aSpec menu.
  widget keystrokeActionSelector: aSpec keyPress.
  widget nodeClass: aSpec nodeClass.
  widget getRootsSelector: aSpec roots.
  widget autoDeselect: aSpec autoDeselect.
+
  widget dropItemSelector: aSpec dropItem.
  widget wantsDropSelector: aSpec dropAccept.
  widget dragItemSelector: aSpec dragItem.
+ widget dragStartedSelector: aSpec dragStarted.
+
  widget columns: aSpec columns.
 
  "Override default scroll bar policies if needed. Widget will use preference values otherwise."
  aSpec hScrollBarPolicy ifNotNil: [:policy |
  policy caseOf: {
  [#always] -> [widget alwaysShowHScrollBar].
  [#never] -> [widget hideHScrollBarIndefinitely].
  [#whenNeeded] -> [widget showHScrollBarOnlyWhenNeeded]. } ].
  aSpec vScrollBarPolicy ifNotNil: [:policy |
  policy caseOf: {
  [#always] -> [widget alwaysShowVScrollBar].
  [#never] -> [widget hideVScrollBarIndefinitely].
  [#whenNeeded] -> [widget showVScrollBarOnlyWhenNeeded]. } ].
 
  self setFrame: aSpec frame in: widget.
  self setLayoutHintsFor: widget spec: aSpec.
 
  parent ifNotNil:[self add: widget to: parent].
  " panes ifNotNil:[
  aSpec roots ifNotNil:[panes add: aSpec roots].
  ]. "
  ^widget!

Item was changed:
  PluggableListMorph subclass: #PluggableListMorphPlus
+ instanceVariableNames: 'dragItemSelector dropItemSelector wantsDropSelector getHelpSelector dragTypeSelector dragStartedSelector'
- instanceVariableNames: 'dragItemSelector dropItemSelector wantsDropSelector getHelpSelector dragTypeSelector'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'ToolBuilder-Morphic'!
 
  !PluggableListMorphPlus commentStamp: 'ar 7/15/2005 11:10' prior: 0!
  Extensions for PluggableListMorph needed by ToolBuilder!

Item was changed:
  ----- Method: PluggableListMorphPlus>>acceptDroppingMorph:event: (in category 'drag and drop') -----
+ acceptDroppingMorph: aTransferMorph event: evt
+
+ dropItemSelector ifNil: [^ self].
+ potentialDropRow ifNil: [^ self].
+
+ model
+ perform: dropItemSelector
+ withEnoughArguments: {
+ aTransferMorph passenger.
+ potentialDropRow.
+ aTransferMorph shouldCopy.
+ aTransferMorph}.
+
- acceptDroppingMorph: aMorph event: evt
- | item |
- dropItemSelector isNil | potentialDropRow isNil ifTrue: [^self].
- item := aMorph passenger.
- model perform: dropItemSelector with: item with: potentialDropRow.
  self resetPotentialDropRow.
  evt hand releaseMouseFocus: self.
  Cursor normal show.
  !

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

Item was added:
+ ----- Method: PluggableListMorphPlus>>dragStartedSelector: (in category 'accessing') -----
+ dragStartedSelector: symbol
+ dragStartedSelector := symbol.!

Item was changed:
  ----- Method: PluggableListMorphPlus>>startDrag: (in category 'drag and drop') -----
  startDrag: evt
+
+ | item itemMorph modelIndex |
-
  dragItemSelector ifNil:[^self].
  evt hand hasSubmorphs ifTrue: [^ self].
+ self model okToChange ifFalse: [^ self].
+
+ item := self selection ifNil: [^ self].
+ itemMorph := StringMorph contents: item asStringOrText.
+ modelIndex := self modelIndexFor: self selectionIndex.
+
+ [ "Initiate drag."
+ (self model perform: dragItemSelector with: modelIndex) ifNotNil: [:passenger | | ddm |
+ ddm := (self valueOfProperty: #dragTransferClass ifAbsent: [TransferMorph]) withPassenger: passenger from: self.
+ ddm dragTransferType: (self dragTypeSelector ifNotNil: [:s | self model perform: s with: modelIndex]).
+ ddm updateFromUserInputEvent: evt.
+ self dragStartedSelector ifNotNil: [:s | self model perform: s with: itemMorph with: ddm].
+ evt hand grabMorph: ddm].
+ ] ensure: [
+ Cursor normal show.
+ evt hand releaseMouseFocus: self]!
- [ | dragIndex draggedItem ddm |
- (self dragEnabled and: [model okToChange]) ifFalse: [^ self].
- dragIndex := self rowAtLocation: evt position.
- dragIndex = 0 ifTrue:[^self].
- draggedItem := model perform: dragItemSelector with: (self modelIndexFor: dragIndex).
- draggedItem ifNil:[^self].
- ddm := TransferMorph withPassenger: draggedItem from: self.
- ddm dragTransferType: (self dragTypeSelector
- ifNil: [#dragTransferPlus]
- ifNotNil: [:s | self model perform: s with: (self modelIndexFor: dragIndex)]).
- evt hand grabMorph: ddm]
- ensure: [Cursor normal show.
- evt hand releaseMouseFocus: self]!

Item was changed:
  ----- Method: PluggableListMorphPlus>>wantsDroppedMorph:event: (in category 'drag and drop') -----
+ wantsDroppedMorph: aTransferMorph event: anEvent
+
+ dropItemSelector ifNil: [^ false].
+ wantsDropSelector ifNil: [^ true].
+
+ (aTransferMorph isKindOf: TransferMorph) ifFalse: [^ false].
+
+ ^ model perform: wantsDropSelector withEnoughArguments: {
+ aTransferMorph passenger.
+ aTransferMorph dragTransferType.
+ aTransferMorph source.
+ aTransferMorph}!
- wantsDroppedMorph: aMorph event: anEvent
- aMorph dragTransferType == #dragTransferPlus ifFalse:[^false].
- dropItemSelector ifNil:[^false].
- wantsDropSelector ifNil:[^true].
- ^(model perform: wantsDropSelector with: aMorph passenger) == true!

Item was changed:
  SimpleHierarchicalListMorph subclass: #PluggableTreeMorph
+ instanceVariableNames: 'rootWrappers selectedWrapper getRootsSelector getChildrenSelector hasChildrenSelector getLabelSelector getIconSelector getSelectedPathSelector setSelectedParentSelector getHelpSelector dropItemSelector wantsDropSelector dragItemSelector dragTypeSelector nodeClass lastKeystrokeTime lastKeystrokes dragStartedSelector'
- instanceVariableNames: 'rootWrappers selectedWrapper getRootsSelector getChildrenSelector hasChildrenSelector getLabelSelector getIconSelector getSelectedPathSelector setSelectedParentSelector getHelpSelector dropItemSelector wantsDropSelector dragItemSelector dragTypeSelector nodeClass lastKeystrokeTime lastKeystrokes'
  classVariableNames: 'FilterByLabelsOnly MaximumSearchDepth'
  poolDictionaries: ''
  category: 'ToolBuilder-Morphic'!
 
  !PluggableTreeMorph commentStamp: 'ar 2/12/2005 04:38' prior: 0!
  A pluggable tree morph.!

Item was changed:
+ ----- Method: PluggableTreeMorph>>acceptDroppingMorph:event: (in category 'drag and drop') -----
- ----- Method: PluggableTreeMorph>>acceptDroppingMorph:event: (in category 'morphic') -----
  acceptDroppingMorph: aTransferMorph event: evt
+
+ dropItemSelector ifNil: [^ self].
+ potentialDropMorph ifNil: [^ self].
+
- dropItemSelector ifNil: [ ^ self ].
  model
  perform: dropItemSelector
+ withEnoughArguments: {
+ aTransferMorph passenger.
+ potentialDropMorph withoutListWrapper.
+ aTransferMorph shouldCopy.
+ aTransferMorph}.
+
+ self resetPotentialDropMorph.
- withEnoughArguments: {aTransferMorph passenger.
- (self itemFromPoint: evt position) withoutListWrapper.
- aTransferMorph shouldCopy}.
  evt hand releaseMouseFocus: self.
- potentialDropMorph ifNotNil: [ potentialDropMorph highlightForDrop: false ].
  Cursor normal show!

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

Item was added:
+ ----- Method: PluggableTreeMorph>>dragStartedSelector: (in category 'accessing') -----
+ dragStartedSelector: aSymbol
+ dragStartedSelector := aSymbol.!

Item was changed:
  ----- Method: PluggableTreeMorph>>setSelectedMorph: (in category 'selection') -----
  setSelectedMorph: aMorph
+
+ "Avoid unnecessary model callbacks."
+ self selectedMorph == aMorph ifTrue: [^ self].
+
  selectedWrapper := aMorph complexContents.
 
  "Let the model now about the selected object, not wrapper."
  setSelectionSelector ifNotNil: [:symbol |
  model
  perform: symbol
  with: (selectedWrapper ifNotNil: [:w | w item])].
 
  "The model may not have access to the parent object in terms of this tree structure."
  setSelectedParentSelector ifNotNil: [:symbol |
  model
  perform: symbol
  with: (selectedWrapper ifNotNil: [:w | w parent ifNotNil: [:pw | pw item]])].!

Item was changed:
+ ----- Method: PluggableTreeMorph>>startDrag: (in category 'drag and drop') -----
- ----- Method: PluggableTreeMorph>>startDrag: (in category 'morphic') -----
  startDrag: evt
+
+ | itemMorph |
+ self dragItemSelector ifNil: [^ self].
+ evt hand hasSubmorphs ifTrue: [^ self].
+ self model okToChange ifFalse: [^ self].
+
+ itemMorph := scroller submorphs
+ detect: [:any | any highlightedForMouseDown]
+ ifNone: [^ self].
+
+ "Prepare visuals."
- | ddm itemMorph passenger |
- self dragEnabled
- ifTrue: [itemMorph := scroller submorphs
- detect: [:any | any highlightedForMouseDown]
- ifNone: []].
- (itemMorph isNil
- or: [evt hand hasSubmorphs])
- ifTrue: [^ self].
  itemMorph highlightForMouseDown: false.
+ self setSelectedMorph: itemMorph.
+
+ [ "Initiate drag."
+ (self model perform: self dragItemSelector with: itemMorph withoutListWrapper) ifNotNil: [:passenger | | ddm |
+ ddm := (self valueOfProperty: #dragTransferClass ifAbsent: [TransferMorph]) withPassenger: passenger from: self.
+ ddm dragTransferType: (self dragTypeSelector ifNotNil: [:s | self model perform: s with: itemMorph withoutListWrapper]).
+ ddm updateFromUserInputEvent: evt.
+ self dragStartedSelector ifNotNil: [:s | self model perform: s with: itemMorph with: ddm].
- itemMorph ~= self selectedMorph
- ifTrue: [self setSelectedMorph: itemMorph].
- passenger := self model perform: dragItemSelector with: itemMorph withoutListWrapper.
- passenger
- ifNotNil: [ddm := TransferMorph withPassenger: passenger from: self.
- ddm dragTransferType: (self dragTypeSelector
- ifNil: [#dragTransferPlus]
- ifNotNil: [:s | self model perform: s with: itemMorph withoutListWrapper]).
- Preferences dragNDropWithAnimation
- ifTrue: [self model dragAnimationFor: itemMorph transferMorph: ddm].
  evt hand grabMorph: ddm].
+ ] ensure: [
+ Cursor normal show.
+ evt hand releaseMouseFocus: self].!
- evt hand releaseMouseFocus: self!

Item was changed:
+ ----- Method: PluggableTreeMorph>>wantsDroppedMorph:event: (in category 'drag and drop') -----
+ wantsDroppedMorph: aTransferMorph event: anEvent
+
+ dropItemSelector ifNil: [^ false].
+ wantsDropSelector ifNil: [^ true].
+
+ (aTransferMorph isKindOf: TransferMorph) ifFalse: [^ false].
+
+ ^ model perform: wantsDropSelector withEnoughArguments: {
+ aTransferMorph passenger.
+ aTransferMorph dragTransferType.
+ aTransferMorph source.
+ aTransferMorph}!
- ----- Method: PluggableTreeMorph>>wantsDroppedMorph:event: (in category 'morphic') -----
- wantsDroppedMorph: aMorph event: anEvent
- aMorph dragTransferType == #dragTransferPlus ifFalse:[^false].
- dropItemSelector ifNil:[^false].
- wantsDropSelector ifNil:[^true].
- ^ (model perform: wantsDropSelector with: aMorph passenger) == true.!