CJB: Based upon Widget Drag and Drop BWidget Notebook.
Allows dragging and dropping widgets into ttk::notebook pages or tabs. Does not require BWidget.
package require Tk 8.5
#Create main widgets.
set m [frame .m]
set p [panedwindow $m.p]
$p add [set f [frame $p.f] ]
$p add [set n [ttk::notebook $p.n] ]
pack $m -fill both -expand 1
pack $p -fill both -expand 1
#DnD Source binds
bind DropSource <ButtonPress> [list ChildButtonPress %W]
bind DropSource <ButtonRelease> [list ChildButtonRelease %W %X %Y %x %y]
bind DropSource <Motion> [list ChildMotion %W %X %Y %x %y]
#DnD Target binds
bind DropTarget <<ChildDrop>> [list ChildDrop %d %W %x %y]
bindtags $f [linsert [bindtags $f] 1 DropTarget]
bindtags $n [linsert [bindtags $n] 1 DropTarget]
#Tab creation
foreach tab [list First Second Third] {
set w [frame $n.[string tolower $tab]]
$n add $w -text $tab
bindtags $w [linsert [bindtags $w] 1 DropTarget]
}
#DnD Source Creation
foreach text [list "Child A" "Child B" "Child C" "Child D" "Child E"] {
set w $p.[string map {{ } _} [string tolower $text]]
label $w -text $text -background lightgray
bindtags $w [linsert [bindtags $w] 1 DropSource ]
pack $w -in $f -fill x
}
#Sets "active" widget and colors it green.
proc ChildButtonPress {w} {
variable active $w
$w configure -background green
}
#Generates a <<ChildDrop>> event on the underlying widget
#The child will be colored red if an error occurs.
proc ChildButtonRelease {W X Y x y } {
variable active
if {[info exists active]} {
set z [winfo containing $X $Y]
$W configure -background red
catch {
set x [expr {$X - [winfo rootx $z]}]
set y [expr {$Y - [winfo rooty $z]}]
event generate $z <<ChildDrop>> -x $x -y $y -data $W
$W configure -background lightgray
} m o
if {[dict get $o -code] != 0} {puts stderr $m}
unset -nocomplain active
}
}
#Passes <Motion> events to underlying widgets while dragging children.
proc ChildMotion {W X Y x y} {
set w [winfo containing $X $Y]
if {$w ne $W && $w ne ""} {
set x [expr {$X - [winfo rootx $w]}]
set y [expr {$Y - [winfo rooty $w]}]
event generate $w <Motion> -x $x -y $y
}
}
#Called on widgets that a DropSource has been released upon.
proc ChildDrop {slave master x y} {
puts "ChildDrop: $slave -> $master"
if {[winfo class $master] eq "TNotebook"} {
set idx [$master index @$x,$y]
if {$idx == ""} {
return
} else {
set master [lindex [$master tabs] $idx]
}
}
pack $slave -in $master
raise $slave
}
#Utility for debugging binds/traces
proc print {args} {puts $args}
bind all <KeyPress-question> {console show}