if 0 {[Kevin Walzer] July 7, 2006: I have wanted to add drag-and-drop functionality to my applications for some time, and BWidgets has the most portable implementation of drag-and-drop that I am aware of. However, the BWidgets documentation is complex, the code in the demos is incomplete, and available, easily-grasped samples at the wiki or other online resources are scarce. So, I have spent the past few weeks cobbling up this demo, which shows how to use drag-and-drop in BWidgets for the following types of widgets: ListBox, Tree, tablelist, text, and button. This demo illustrates how to use BWidgets' default drag-and-drop commands for those widgets that support them, and also how to register widgets to allow drag and drop events. I have not included drag-and-drop for BWidgets labels or entry widgets, because the code samples for these widgets--found in the BWidgets demo--is reasonably clear and easy to follow.

My code also includes annotations as to what is happening, since many of the BWidgets are less-than-clear as to the meaning of the parameters they define or require. Looking at my annotations and reviewing both the BWidgets documentation and the code samples in the standard BWidgets demo may be a good approach to understanding BWidgets drag-and-drop more fully.

This demo includes code snippets adapted  from the following sources: http://www.interq.or.jp/japan/s-imai/tcltk/bwidget.html; http://wiki.tcl.tk/14562; http://wiki.tcl.tk/5527; http://blogs.ya.com/leandro/files/iroster.tcl; from a posting by mdn on [c.l.t.] and from [Csaba Nemethi] on [c.l.t.] If I have overlooked anything, please let me know and I will add it to this list.}

if 0 {Let's draw the GUI first.}
  proc drawGUI {} {

    package require BWidget 
    package require tablelist

    wm title . "BWidgets Drag and Drop Demo"

if 0 {Here we draw a Tree widget. The BWidgets Tree has simple callbacks to register drag events and drop events with the -dragenabled and -dropenabled parameters. You do need to define a custom dropcmd callback, however.}
    
    Tree .tree  -opencmd "change 1" -closecmd "change 0" -selectfill 1 -dropenabled 1 -dragenabled 1  -dropcmd dropTreeCmd -dragevent 1  -droptypes { 
        TREE_NODE    {copy {} move {} link {}} 
        LISTBOX_ITEM {copy {} move {} link {}} 
        TABLELIST_ROW {copy {} move {} link {}}
    } 

    pack .tree -fill both -expand yes -side right

    .tree insert end root Foo -text Foo -image [Bitmap::get folder] -open 0 
    .tree insert end root Bar -text Bar -image [Bitmap::get folder] -open 0 

    .tree insert end Foo  One -text One -image [Bitmap::get file] 
    .tree insert end Foo  Two -text Two -image [Bitmap::get file] 
    .tree insert end Foo Three -text Three -image [Bitmap::get file] 

    .tree insert end Bar Four -text Four -image [Bitmap::get file] 
    .tree insert end Bar Five -text Five -image [Bitmap::get file] 
    .tree insert end Bar Six -text Six -image [Bitmap::get file] 

    .tree bindText <1> click 

if 0 {Here we draw a ListBox widget. The BWidgets ListBox also has simple callbacks to register drag events and drop events with the -dragenabled and -dropenabled parameters. You do need to define a custom dropcmd callback, however.}

    ListBox .listbox -dragenabled 1 -dragevent 1 -dropenabled 1  -dropcmd dropLB -droptypes { 
        TREE_NODE    {copy {} move {} link {}} 
        LISTBOX_ITEM {copy {} move {} link {}}
        TABLELIST_ROW {copy {} move {} link {}} } 
    pack .listbox -fill both -expand yes -side right

    foreach item {Do Re Mi} {.listbox insert end $item -text $item -image  [Bitmap::get file]  } 

if 0 {Here we draw a .text widget. In BWidgets, the Label, ListBox and Tree components have default settings that register them as dropsites and dragsites. For other widgets, we must call DropSite::register to allow the widget to receive drop events and DragSite::register to allow the widget to receive drag events. Here we are registering .textbox as a DropSite. This command identifies the widget (.textbox), the callback that is executed when an item is dropped (droptext), and the droptypes.}

  text .textbox

    DropSite::register .textbox -dropcmd {droptext} -droptypes { 
        TREE_NODE    {copy {} move {} link {}} 
        LISTBOX_ITEM {copy {} move {} link {}}
        TABLELIST_ROW {copy {} move {} link {}} }

    pack .textbox -fill both -expand yes -side left
    .textbox insert end "Drop items here.\n"

if 0 {Here we draw the tablelist widget. Note that this code sample illustrates how to use an image on each row of the tablelist.}

    tablelist::tablelist .t -columns {0 "First Column" 0 "Second Column"} -stretch all -background white 

    pack .t -fill both -expand yes -side left
    .t insert end [list "Row 1" "Fa"]
    .t insert end [list "Row 2" "So"]

        foreach col {0 end} {
            .t cellconfigure $col,0 -image [Bitmap::get file]
        }


if 0 {Here we register the tablelist widget as a dropsite. Note that you must use the bodypath component of the tablelist widget to register the dropsite; using the tablelist itself will not work.}

    DropSite::register [.t bodypath] -dropcmd {droppedlist} -droptypes { 
        TREE_NODE    {copy {} move {} link {}} 
        LISTBOX_ITEM {copy {} move {} link {}}
        TABLELIST_ROW {copy {} move {} link {}}} 


if 0 {Here we register the tablelist widget as a dragsite. Note that you must use the bodypath component of the tablelist widget to register the dragsite; using the tablelist itself will not work.}

    DragSite::register [.t bodypath] -dragevent 1 -draginitcmd tabledrag -dragendcmd tabledrop

if 0 {Here we have to bind the data type TABLELIST_ROW to the mouse using the DragSite::include command.}

    DragSite::include Widget TABLELIST_ROW <B1-Motion>

if 0 {Here we draw a button widget. The button widget must be registered as a DropSite to receive drop events.}

    button .b  -text "Drop on Me" -command dropbut
    pack .b -side left

    DropSite::register .b -dropcmd {dropbut} -droptypes { 
        TREE_NODE    {copy {} move {} link {}} 
        LISTBOX_ITEM {copy {} move {} link {}}
        TABLELIST_ROW {copy {} move {} link {}}} 


if 0 {The GUI is now complete!}
 }

if 0 {This procedure triggers the opening and closing of the Tree nodes.}

 proc change {idx node} {
    .tree itemconfigure $node -image [Bitmap::get folder]
 } 

if 0 {This procedure registers when a Tree node is chosen.}
 proc click {node} { 
    global var 
    .tree selection set $node 
    set var [.tree selection get] 
 } 

if 0 {Here we define the dropcmd for the Tree widget. Note that the "puts" statement lists the args for the procedure; this is helpful for understanding what is happening. The $lDrop list indicates on which node the data is dropped.}

if 0 {[Tim Davis] 16-Aug-2006: The node name on insert must be unique or else you get a never ending barrage of error dialogs. Since this is an example (and I had to look it up) I decided to add a little bit about the syntax of the lDrop data list.}

 proc dropTreeCmd {treewidget drag_source lDrop op dataType data} {
    puts [list $treewidget $drag_source $lDrop $op $dataType $data]
    switch [lindex $lDrop 0] {
        widget {
      # "widget"
      $treewidget insert end root ${data}_[unique] -text $data -image  [Bitmap::get file]
        }
        node {
      # "node" <node>
      $treewidget insert end [lindex $lDrop 1] ${data}_[unique] -text $data -image  [Bitmap::get file]
        }
        position {
      # "position" <node> <index>
      $treewidget insert [lindex $lDrop 2] [lindex $lDrop 1] ${data}_[unique] -text $data -image  [Bitmap::get file]
        }
        default {
            return -code error "DropCmd called with impossible wherelist."
        }
    }
    return 1
 }

 set __unique -1
 proc unique {} {
   global __unique
   return [incr __unique]
 }
 
if 0 {This procedure is the draginitcmd for the tablelist--the callback that is executed when the drag motion begins. We must define this because tablelist does not support such a binding by default. The $top variable refers to the toplevel window that is created by the drag motion; by default this window is filled with the BWidget file image. Here we create a custom label, $top.label. This command ends by defining and returning the TABLELIST_ROW datatype that is used to register the tablelist drag and drop events with other widgets.  Note that the "puts" statement lists the args for the procedure; this is helpful for understanding what is happening.}

 proc tabledrag {target x y top} {
    puts [list $target $x $y $top]
    set data1  [lindex [.t get [.t curselection]] 0]
    set data2 [lindex [.t get [.t curselection]] 1]
    set data "$data1 / $data2"
    label $top.label -text $data  -bd 0 
    pack $top.label
    return [list TABLELIST_ROW move $data]    
 }

if 0 {This procedure is the dragendcmd--the callback that is executed when the drag motion stops--for the tablelist, .t. We must define this because tablelist does not support such a binding by default.  Note that the "puts" statement lists the args for the procedure; this is helpful for understanding what is happening.}

 proc tabledrop {source target op type data result} {
    puts [list $source $target $op $type $data $result]
 }


if 0 {Here we define the dropcmd for the tablelist, .t. Note that this command includes an example of how to append an image to a tablelist row.}

 proc droppedlist {args} {
    set newdata [lindex $args end]
    puts $newdata
    .t insert end [list "dropped" "$newdata"]
   .t cellconfigure end,0 -image [Bitmap::get file]   
 }

if 0 {Here we define the dropcmd for .textbox.}

 proc droptext {args} { 
    .textbox insert end "dropped with $args\n"
 } 

if 0 {Here we define the dropcmd for the button .b.}

 proc dropbut {args} {
    tk_messageBox -message "$args" 
 }


if 0 {Here we define the dropcmd for the ListBox. Note that the "puts" statement lists the args for the procedure; this is helpful for understanding what is happening.}

 proc dropLB {listbox dragsource itemList operation datatype data} { 
    puts [list $listbox $dragsource $itemList $operation $datatype $data]
    $listbox insert end $data -text $data -image [Bitmap::get file] 
 } 

if 0 {And now let's get started!}

 drawGUI

if 0 {Note that these commands only pertain to the moving of the widgets and their data around on the screen. It would be easy to define additional commands to execute when a drop event fires; for instance, a file could be copied from one location to another.

Of course, additions, corrections and revisions to the above code are always welcome!}


----
'''[razor] - 2009-10-31 15:28:59'''

Q: Is it possible to make a button as draggable?
A: [JOB] Buttons aren't drag enabled (without altering the code), but BW Label widgets are (if you essentially need this feature you could either come along with a patch or do a feature request, if you like...).


----
!!!!!!
%| [Category Example] | [Category GUI] |%
!!!!!!