BWidget example: Drag and Drop Demo

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 ; https://wiki.tcl-lang.org/14562 ; https://wiki.tcl-lang.org/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.

Let's draw the GUI first.

  proc drawGUI {} {

    package require BWidget 
    package require tablelist

    wm title . "BWidgets Drag and Drop Demo"

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

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]  }

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"

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]
        }

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 {}}}

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

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>

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 {}}}

The GUI is now complete!

This procedure triggers the opening and closing of the Tree nodes.

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

This procedure registers when a Tree node is chosen.

 proc click {node} { 
    global var 
    .tree selection set $node 
    set var [.tree selection get] 
 }

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.

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]
 }

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]    
 }

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]
 }

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]   
 }

Here we define the dropcmd for .textbox.

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

Here we define the dropcmd for the button .b.

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

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] 
 }

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...).

Q: razor The contents of the tablelist widget are not drag enabled,but this demo program shows how to enable it,using DragSite::register and DragSite::include commands.I thought even the button widget could be dragged.How to do a feature request?

LVwikignome - 2009-11-02 10:11:06

to add a feature request, just visit the sf.net project where bwidget resides, and there should be an option on the sf project page for feature requests.

A: JOB Thank you Larry for answering the question. The good thing is, that my above statement was wrong: the dnd implementation of BW allows to register nearly and kind of widget type. So dnd for Button widgets works. The following script shows a minimal example. I can imagine, to use this for a user configureable toolbar:

#! /bin/sh
# Restart using wish \
exec wish "$0" ${1+"$@"}

# -------------------------------------------------------------------------
# dnd_button_demo.tcl ---
# A minmal example for a DnD demo with buttons.
# Johann Oberdorfer at gmail dot com 
# -------------------------------------------------------------------------


# where to find BWidget package
lappend auto_path [file join [file dirname [info script]] ..]   

package require BWidget ;# 1.9.1

   # new options available since 1.9.1 (currently only available in CVS):
   # BWidget::use -package ttk \
   #   -themedirs [list [file join $::BWIDGET::LIBRARY demo themes]] \
   #   -style winxpblue

proc dragbuttonCmd {wtarget x y top} {
    # tk_messageBox -message "$wtarget : $x : $y : $top"
    set txt [$wtarget cget -text]
    set img [$wtarget cget -image]

    label $top.label -text $txt -image $img -compound left -bd 0
    pack $top.label

    return [list BUTTON_ITEM move $txt]
}


proc dropbuttonCmd {args} {
    # tk_messageBox -message "$args"

    set wSource   [lindex $args 0]
    set wTarget   [lindex $args 1]
    set sourceTxt [$wSource cget -text]
    set sourceImg [$wSource cget -image]
    set sourceCmd [$wSource cget -command]

    set targetTxt [$wTarget cget -text]
    set targetImg [$wTarget cget -image]
    set targetCmd [$wTarget cget -command]

    # so something fancy with the button...

    $wSource configure -text $targetTxt -image $targetImg -command $targetCmd
    $wTarget configure -text $sourceTxt -image $sourceImg -command $sourceCmd
}

proc droppedOntoButtonCmd {args} {
    # tk_messageBox -message "$args"
    # set newdata [lindex $args end]
}


proc enableDnD { wList } {

  foreach w $wList {

    # Here we register the widget as a dropsite.

    DropSite::register $w \
        -dropcmd {dropbuttonCmd} \
        -droptypes {
            BUTTON_ITEM  {copy {} move {} link {}}
        }

    # Here we register the widget as a dragsite.

    DragSite::register $w \
        -dragevent 1 \
        -draginitcmd dragbuttonCmd \
        -dragendcmd  droppedOntoButtonCmd

    # Here we have to bind the data type BUTTON_ITEM to the mouse.

    DragSite::include Widget BUTTON_ITEM <B1-Motion>
  }
}


proc wrap {wtype wpath args} {
    if { [catch {uplevel "#0" package require tile}] == 0 } {
        return [eval ttk::${wtype} $wpath $args]
    } else {
        return [eval $wtype $wpath $args]
    }
}


proc drawGUI {} {
    variable wList
    
    wm withdraw .
    set t [toplevel .t]
    wm title $t "BWidgets Demo for Drag 'n Drop enabled buttons."

    pack [set f [wrap frame $t.f]] -fill both -expand true

    pack [wrap button $f.b1 \
             -text "1.) Drag" -image [Bitmap::get new] -compound left \
             -command {tk_messageBox -message "Drag"}] -padx 5 -pady 5

    pack [wrap button $f.b2 \
             -text "2.) and"  -image [Bitmap::get file] -compound left \
             -command {tk_messageBox -message "and"}] -padx 5 -pady 5

    pack [wrap button $f.b3 \
             -text "3.) Drop" -image [Bitmap::get copy] -compound left \
             -command {tk_messageBox -message "Drop"}] -padx 5 -pady 5

    pack [wrap button $f.b4 \
             -text "4.) Demo" -image [Bitmap::get redo] -compound left \
             -command {tk_messageBox -message "Demo"}] -padx 5 -pady 5

    enableDnD [list $f.b1 $f.b2 $f.b3 $f.b4]

    pack [wrap label $f.lbl -text ""] -padx 5 -pady 5
    pack [wrap button $f.b5 -text "Exit Demo." -command {exit 0}] -padx 5 -pady 5
}


drawGUI

A: razor Many thanks for showing how to drag a button,Johann.Here a button is dragged and is dropped onto another button.Is it possible to drag a button itself i.e. change its position on the screen? I tried using place $button -in $top -x $new_x -y $new_y but it didn't work.

JOB What we have seen so far is that the DnD implementation acts on widgets, which need to exist (on the "screen") and also registered for DnD. When moving the mouse, you "know" the source object (see demo code) - so you might be able to copy the object's properties in order to re-create a dummy object which is shown in place of the mouse pointer. When you drop over a target widget, you need somehow to implement a logic: ... get parent of the target , e.g. use pack/place -parent ... to create the new button ....

razorGot it. First I registered the top level window as a drop site for dropping buttons.Then I modified your dropbuttonCmd procedure like this:

    set new_x [lindex $args 2] #gets mouse pointer's current x postion
    set new_y [lindex $args 3] #gets mouse pointer's current y postion

    place $wTarget -in $wSource -x $new_x -y $new_y #places the dragged button in the current mouse pointer position.

Thanks a ton for your help,Johann. Note:For the button,data type BUTTON_ITEM has been used.How to know what data type to use for a particular widget? JOB From my understanding, BUTTON_ITEM is just a key-string (freely to choose), all it matters is to reference the same key-word for related proc calls (e.g.: DragSite::register -> DragSite::include). My pleasure to help you out!

Category Example

Category GUI