Posted to tcl by egavilan at Tue Oct 20 21:36:30 GMT 2015view pretty

namespace eval ::ttk {
    bind Wrapframe <FocusIn>  {%W#border state  focus}
    bind Wrapframe <FocusOut> {%W#border state !focus}
    bind Wrapframe <Destroy>  {rename %W {}}
    interp alias {} ::ttk::text    {} ::ttk::WrapWidget text
    interp alias {} ::ttk::listbox {} ::ttk::WrapWidget listbox
    interp alias {} ::ttk::canvas  {} ::ttk::WrapWidget canvas

    proc WrapWidget {class path args} {
        # handle the args
        set args [dict replace $args \
            -background white \
            -borderwidth 0 \
            -highlightthickness 0]
        set args [dict remove $args -bg -bd]

        # real widget
        set rw $path.$class

        # create the container frame and the widget
        frame $path -style TEntry -class Wrapframe
        uplevel 1 [linsert $args 0 $class $rw]
        pack $rw -expand 1 -fill both -padx 2 -pady 2

        # rename the container widget cmd and install a proxy cmd
        # to the real one
        rename ::$path ::$path#border
        interp alias {} ::$path {} ::ttk::WrapProxy $rw

        # adjust bindtags to contain the wrapper name too
        bindtags $rw [linsert [bindtags $rw] 0 $path]

        # adjust the select{fore|back}ground with the theme
        bind $rw <<ThemeChanged>> [list apply {rw {
            $rw configure -selectbackground \
                [ttk::style configure . -selectbackground]
            $rw configure -selectforeground \
                [ttk::style configure . -selectforeground]
        }} $rw]
        after idle [list after 0 [list event generate $rw <<ThemeChanged>>]]

        return $path
    }

    # prevent the wrapper window to take focus
    proc WrapProxy {w args} {
        if {[lindex $args 0] eq "cget" &&
            [lindex $args 1] eq "-takefocus"
        } then {
            return 0
        }
        uplevel 1 [linsert $args 0 $w]
    }
}

# create a toplevel with a background ttk::frame
proc ttk::toplevel {path args} {
    ::toplevel $path {*}$args
    while 1 {
        set bw ${path}.background#[incr i]
        if {![winfo exists $bw]} break
    }
    place [frame $bw] -x 0 -y 0 -relwidth 1.0 -relheight 1.0
    return $path
}