From VisualWorks®, 7.6 of February 1, 2008 on February 1, 2008 at 12:49:38 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>TreeDDExample</name> <environment>Examples</environment> <super>UI.ApplicationModel</super> <private>false</private> none treeList <imports></imports> <category>Drag Drop-Examples</category> <attributes> <package>DragDrop-TreeView-Example</package> </attributes> </class> <comment> Examples.TreeDDExample
TreeDDExample demonstrates sorting or inserting portions of a tree view heirarchy by a drag and drop of selected nodes. To start, select 'Add new root' from the tree view menu to add 'Object' to the tree. Press 'Spawn' to create a new instance of TreeDDExample. Any node dragged from the tree may be dropped to a new position in the tree or moved to another instance of TreeDDExample. Instance Variables: treeList <MultiSelectionInTree> List model of sample heirarchy
</comment> <class> <name>MockClassWrapper</name> <environment>Examples</environment> <super>Core.Object</super> <private>false</private> none subject children parent <imports></imports> <category>Drag Drop-Examples</category> <attributes> <package>DragDrop-TreeView-Example</package> </attributes> </class> <comment> Examples.MockClassWrapper
MockClassWrapper mocks a Class for appearence as a node in a sample TreeView heirarchy Instance Variables: children <OrderedCollection | nil> collection of my children, if any, originally derived as subclasses of my subject class. parent <MockClassWrapper> my parent in this heirarchy which may be distinct from my subject superclass. subject <Class> subject class.
</comment> <methods> Examples.TreeDDExample <category>actions</category>
addObject self treeList list root addChild: (MockClassWrapper on: Object). self treeList list refreshRoot
deleteSelection self treeList selectionDo: [:item | item parent: nil]. self treeList tree removeAll: (self treeList selectionIndexes collect: [:each | self treeList tree wrapperAt: each])
spawn self class open
</methods> <methods> Examples.TreeDDExample <category>drag and drop</category>
doDragTree: aController "Drag the currently selected change. Include all available information so that the drop target can use whatever it needs." | data | data := DragDropData new. data contextWindow: builder window. data contextWidget: aController view. data contextApplication: self. data clientData: self treeList. (DragDropManager withDropSource: DropSource new withData: data) doDragDrop
dragEnterTree: aDragContext "A drag has entered a target TreeView. If the receiver is happy to accept a drag then fill-in the appropriate data and answer that dragging should continue." (aDragContext data contextApplication isKindOf: self class) ifFalse: [^#dropEffectNone]. aDragContext dropTarget clientData: (self initialDropState: (self widgetAt:#TreeView1)). ^#dropEffectMove
dragLeave: aDragContext "A drag has left the tree. If the drag contains a change, we must restore the tree state" self == aDragContext data contextApplication ifTrue: [self restoreListStateFrom: aDragContext dropTarget clientData. aDragContext dropTarget clientData: nil]. ^#dropEffectNone
dragOver: aDragContext "A drag is over the target TreeView. Enable a drop if the drag originated in this application but don't drop a parent to a child or allow coexisting copies of a sibling" ^(aDragContext data contextApplication isKindOf: self class) ifTrue: [| targetView treeModel targetNode targetIndex | targetView := self widgetAt:#TreeView1. targetView showInsertReplaceDropFeedbackIn: aDragContext allowScrolling: true. treeModel := targetView model value. targetIndex := targetView targetIndex. targetIndex < 1 ifFalse: [targetNode := self targetAt: targetIndex inTree: treeModel. "Forbid any ancestor from being dropped on a child" (self dragContext: aDragContext toTree: treeModel includesCopyOf: targetNode) ifTrue: [^#dropEffectNone]. "Forbid adding copies of siblings" (self dragContext: aDragContext toTree: treeModel includesAncestorsOf: targetNode) ifTrue: [^#dropEffectNone]]. aDragContext shiftDown ifTrue: ["Copy" #dropEffectCopy] ifFalse: ["Replace" #dropEffectMove]] ifFalse: [#dropEffectNone]
dragOverTree: aDragContext "A drag is over the target TreeView. Enable a drop if the drag originated in this application but don't drop a parent to a child or allow coexisting copies of a sibling" ^(aDragContext data contextApplication isKindOf: self class) ifTrue: [| targetView treeModel targetNode targetIndex | targetView := self widgetAt:#TreeView1. targetView showInsertReplaceDropFeedbackIn: aDragContext allowScrolling: true. treeModel := targetView model value. targetIndex := targetView targetIndex. targetIndex < 1 ifFalse: [targetNode := self targetAt: targetIndex inTree: treeModel. "Forbid any ancestor from being dropped on a child" (self dragContext: aDragContext toTree: treeModel includesCopyOf: targetNode) ifTrue: [^#dropEffectNone]. "Forbid adding copies of siblings" (self dragContext: aDragContext toTree: treeModel includesAncestorsOf: targetNode) ifTrue: [^#dropEffectNone]]. aDragContext shiftDown ifTrue: ["Copy" #dropEffectCopy] ifFalse: ["Replace" #dropEffectMove]] ifFalse: [#dropEffectNone]
dropTree: aDragContext "A drop has occurred on the target TreeView. Reorder the drop target and drag source tree appropriately." | items targetIndex dropTree source sourceView targetView | targetView := self widgetAt:#TreeView1. sourceView := aDragContext data contextWidget. source := aDragContext data clientData. dropTree := targetView model value. targetIndex := targetView targetIndex. aDragContext shiftDown ifTrue: ["Copy items from source and leave" items := source selections collect: [:each | each copy]] ifFalse: ["Move items from source" | selectionIndexes | selectionIndexes := source selectionIndexes. items := source selections. targetView = sourceView ifTrue: [targetIndex := selectionIndexes inject: targetIndex into: [:sofar :each | each < sofar ifTrue: [sofar - 1 - ((dropTree wrapperAt: each) numberOfOpenChildren min: sofar - each)] ifFalse: [sofar]]]. source tree removeAll: (selectionIndexes collect: [:each | source tree wrapperAt: each])]. self dropAll: items atIndex: targetIndex inTree: dropTree. self treeList selections: items. ^#dropEffectNone
wantToDragTree: treeController "Drag any object" ^true
</methods> <methods> Examples.TreeDDExample <category>private</category>
dragContext: aDragContext toTree: aTreeModel includesAncestorsOf: aTarget "Answer true if any ancestor of aTarget attempts to be dropped on aTarget" | targetParents | targetParents := aTreeModel allParentsFor: aTarget. aDragContext data clientData selectionDo: [:any | (targetParents includes: any) ifTrue: [^true]]. ^false
dragContext: aDragContext toTree: targetTreeModel includesCopyOf: aTarget "Answer true if aTarget is a copy or has children with a copy of any dragged items" | sourceTreeModel | sourceTreeModel := aDragContext data contextWidget model value. targetTreeModel = sourceTreeModel ifFalse: [| siblings | siblings := aTarget children. aDragContext data clientData selectionDo: [:any | (aTarget = any or: [siblings includes: any]) ifTrue: [^true]]]. ^false
dropAll: aCollection atIndex: targetIndex inTree: aTreeModel "Add all dragged items as children to the target at position targetIndex" | target | target := self targetAt: targetIndex inTree: aTreeModel. targetIndex isInteger ifTrue: ["Add dragged items as children to target node" target addChildren: aCollection] ifFalse: ["Insert dragged items as children in the position dropped" targetIndex > aTreeModel size ifTrue: [target addChildren: aCollection] ifFalse: [target addChildren: aCollection before: (aTreeModel at: targetIndex ceiling)]]. aTreeModel refresh: target
initialDropState: aTreeView "Answer the initial state of aTreeView when a drag has begun within its bounds. The state will be used to re-establish the appearance of aTreeView when a drag leaves." | dict | dict := IdentityDictionary new. dict at: #view put: aTreeView. dict at: #targetIndex put: aTreeView targetIndex. dict at: #hasFocus put: aTreeView hasFocus. aTreeView hasFocus: true. ^dict
restoreListStateFrom: aDictionary "Reset the state of the tree when a drag has left its bounds." | dragContextView | dragContextView := aDictionary at: #view. dragContextView targetIndex: (aDictionary at: #targetIndex). dragContextView hasFocus: (aDictionary at: #hasFocus)
targetAt: targetIndex inTree: aTreeModel "If targetIndex is: 1. Less than 1 or greater than aTreeModel size then answer the tree root. 2. A whole number then answer the item at this index position in aTreeModel. 3. A multiple of (1/2) then answer the parent of the item next in sequence." | target | target := (targetIndex < 1 or: [targetIndex > aTreeModel size]) ifTrue: [aTreeModel root] ifFalse: [aTreeModel at: targetIndex ceiling]. targetIndex isInteger ifFalse: [target := target parent ifNil: [aTreeModel root]]. ^target
</methods> <methods> Examples.TreeDDExample <category>aspects</category>
hasSelection ^self treeList selectionIndexes notEmpty
treeList ^treeList isNil ifTrue: [treeList := MultiSelectionInTree new] ifFalse: [treeList]
</methods> <methods> Examples.TreeDDExample <category>interface opening</category>
postBuildWith: aBuilder self treeList list root: (MockClassWrapper on: nil) displayIt: false.
</methods> <methods> Examples.MockClassWrapper <category>comparing</category>
= aMockClassWrapper ^subject = aMockClassWrapper subject
hash ^subject hash
</methods> <methods> Examples.MockClassWrapper <category>adding</category>
addChild: aMockClassWrapper aMockClassWrapper parent: self
addChildren: anArray anArray do:[:aMockClassWrapper| aMockClassWrapper parent: self]
addChildren: anArray before: aMockClassWrapper anArray do: [:wrapper | wrapper parent: self insertBefore: aMockClassWrapper]
</methods> <methods> Examples.MockClassWrapper <category>accessing</category>
children ^children isNil ifTrue: [children := subject ifNil: [OrderedCollection new] ifNotNil: [subject subclasses asOrderedCollection collect: [:cls | MockClassWrapper on: cls parent: self]]] ifFalse: [children]
parent ^parent
parent: aMockClassWrapper | parentChildren | parent ifNotNil: [parent children remove: self ifAbsent: []]. parent := aMockClassWrapper. parent ifNotNil: [((parentChildren := parent children) includes: self) ifFalse: [parentChildren add: self]]
parent: aMockClassWrapper insertBefore: aMockChildWrapper | parentChildren | parent isNil ifFalse: [parent children remove: self ifAbsent: []]. parent := aMockClassWrapper. ((parentChildren := parent children) includes: self) ifFalse: [parentChildren add: self beforeIndex: (parentChildren indexOf: aMockChildWrapper ifAbsent: [parentChildren size])]
subclasses ^self children
subject ^subject
subject: aValue subject := aValue
subject: aValue parent: aMockClassWrapper subject := aValue. parent := aMockClassWrapper
</methods> <methods> Examples.MockClassWrapper <category>printing</category>
displayString ^subject name
</methods> <methods> Examples.MockClassWrapper <category>copying</category>
postCopy super postCopy. children := children ifNotNil:[self children collect:[:each| each copy]].
</methods> <methods> Examples.MockClassWrapper class <category>instance creation</category>
on: aClass ^self new subject: aClass
on: aClass parent: aParentClassWrapper ^self new subject: aClass parent: aParentClassWrapper
</methods> <methods> Examples.TreeDDExample class <category>resources</category>
menuBar "Tools.MenuEditor new openOnClass: self andSelector: #menuBar" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Tree' #submenu: #(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Add new root' #value: #addObject ) #(#{UI.MenuItem} #rawLabel: 'Delete selection' #enabled: false #value: #deleteSelection #enablementSelector: #hasSelection ) ) #(2 ) nil ) ) ) #(1 ) nil ) decodeAsLiteralArray
treeMenu "Tools.MenuEditor new openOnClass: self andSelector: #treeMenu" <resource: #menu> ^#(#{UI.Menu} #( #(#{UI.MenuItem} #rawLabel: 'Add new root' #value: #addObject ) #(#{UI.MenuItem} #rawLabel: 'Delete selection' #enabled: false #value: #deleteSelection #enablementSelector: #hasSelection ) ) #(2 ) nil ) decodeAsLiteralArray
</methods> <methods> Examples.TreeDDExample class <category>interface specs</category>
windowSpec "Tools.UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #properties: #(#{UI.PropertyListDictionary} #sizeType #specifiedSize #positionType #cascade #openType #advanced ) #label: 'Drag and Drop Class Name Hierarchy' #min: #(#{Core.Point} 20 20 ) #max: #(#{Core.Point} 1600 1200 ) #bounds: #(#{Graphics.Rectangle} 640 512 975 868 ) #flags: 4 #menu: #menuBar ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.TreeViewSpec} #properties: #(#{UI.PropertyListDictionary} #dragOkSelector #wantToDragTree: #dragEnterSelector #dragEnterTree: #dragOverSelector #dragOverTree: #dragStartSelector #doDragTree: #dropSelector #dropTree: #dragExitSelector #dragLeave: ) #layout: #(#{Graphics.LayoutFrame} 10 0 10 0 -10 1 -40 1 ) #name: #TreeView1 #model: #treeList #helpText: 'Reorder by drag/drop ' #menu: #treeMenu #multipleSelections: true #useModifierKeys: true #selectionType: #highlight #useIcons: #folder #rootExpander: true ) #(#{UI.ActionButtonSpec} #layout: #(#{UI.AlignmentOrigin} -10 1 -10 1 1 1 ) #name: #ActionButton1 #model: #spawn #label: 'Spawn' #defaultable: true ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 11 0 -32 1 ) #name: #Label1 #label: 'Select ''Add new root'' from the tree menu to start' ) ) ) )
</methods> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>ApplicationModel</name> <environment>UI</environment> <super>UI.Model</super> <private>false</private> none builder uiSession eventHandlers savedWindowInformation <imports></imports> <category>UIBuilder-Framework</category> <attributes> <package>UIBuilder-Framework</package> </attributes> </class>