package require Tk 8.5
package require BWidget 1.9

#Create main widgets.
set m [MainFrame .m]
set p [PanedWindow [$m getframe].p]
set f [frame [$p add].f];#Side frame
set n [NoteBook [$p add].n]
pack $m -fill both -expand 1
pack $p -fill both -expand 1
pack $f -fill both -expand 1
pack $n -fill both -expand 1
$n bindtabs <ButtonPress> [list TabPress %W %x]

#DnD Target binds
$n   bindtabs   <<ChildDrop>> [list ChildDrop %d]
bind DropTarget <<ChildDrop>> [list ChildDrop %d %W]
bindtags $f [linsert [bindtags $f] 1 DropTarget]

#Tab creation
foreach tab [list First Second Third] {
    $n insert end $tab -text $tab
    $n itemconfigure $tab -background #c0c0ff -activebackground #c0ffc0
    set w [$n getframe $tab]
    $w configure -background bisque
    bindtags $w [linsert [bindtags $w] 1 DropTarget]
}
$n raise [$n pages 0]

#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 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
#Needs to generate another event first for the NoteBook to trigger correctly.
#In this case we use an <Enter> event. (Probably not needed in concurrency with ChildMotion)
#The child will be colored red if an error occurs.
proc ChildButtonRelease {W X Y x y } {
    variable active
    variable n
    if {[info exists active]} {
        set z [winfo containing $X $Y]
        $W configure -background red
        catch {
            set x [expr {$X - [winfo rootx $n.c]}]
            set y [expr {$Y - [winfo rooty $n.c]}]
            #Needs a primary event to allow correct trigger on virtual event.
            event generate $z <Enter> -x $x -y $y
            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} {
        set x [expr {$X - [winfo rootx $w]}]
        set y [expr {$Y - [winfo rooty $w]}]
        event generate $w <Motion> -x $x -y $y
    }
}

#If the child is dropped on a frame, it is packed inside the frame.
#If the child is dropped on a notebook tab, it is packed inside the frame for that tab.
#Must be valid or will likely cause an error.
proc ChildDrop {child frame_or_tab} {
    variable n
    puts "ChildDrop: $child  ->  $frame_or_tab"
    if {[winfo exists $frame_or_tab]} {
        pack  $child -in $frame_or_tab
    } else {
        pack  $child -in [$n getframe $frame_or_tab]
    }
    raise $child
}

#Fixes a glitch where clicking on the tab label sets the tab to inactive.
#Mostly a cosmetic fix for active coloring behavior.
proc TabPress {W x tab} {
    event generate $W <Motion> -x $x -y 2
}

#Utility for debugging binds/traces
proc print {args} {puts $args}

bind all <KeyPress-question> {console show}