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 }