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

  1. namespace eval ::ttk {
  2. bind Wrapframe <FocusIn> {%W#border state focus}
  3. bind Wrapframe <FocusOut> {%W#border state !focus}
  4. bind Wrapframe <Destroy> {rename %W {}}
  5. interp alias {} ::ttk::text {} ::ttk::WrapWidget text
  6. interp alias {} ::ttk::listbox {} ::ttk::WrapWidget listbox
  7. interp alias {} ::ttk::canvas {} ::ttk::WrapWidget canvas
  8.  
  9. proc WrapWidget {class path args} {
  10. # handle the args
  11. set args [dict replace $args \
  12. -background white \
  13. -borderwidth 0 \
  14. -highlightthickness 0]
  15. set args [dict remove $args -bg -bd]
  16.  
  17. # real widget
  18. set rw $path.$class
  19.  
  20. # create the container frame and the widget
  21. frame $path -style TEntry -class Wrapframe
  22. uplevel 1 [linsert $args 0 $class $rw]
  23. pack $rw -expand 1 -fill both -padx 2 -pady 2
  24.  
  25. # rename the container widget cmd and install a proxy cmd
  26. # to the real one
  27. rename ::$path ::$path#border
  28. interp alias {} ::$path {} ::ttk::WrapProxy $rw
  29.  
  30. # adjust bindtags to contain the wrapper name too
  31. bindtags $rw [linsert [bindtags $rw] 0 $path]
  32.  
  33. # adjust the select{fore|back}ground with the theme
  34. bind $rw <<ThemeChanged>> [list apply {rw {
  35. $rw configure -selectbackground \
  36. [ttk::style configure . -selectbackground]
  37. $rw configure -selectforeground \
  38. [ttk::style configure . -selectforeground]
  39. }} $rw]
  40. after idle [list after 0 [list event generate $rw <<ThemeChanged>>]]
  41.  
  42. return $path
  43. }
  44.  
  45. # prevent the wrapper window to take focus
  46. proc WrapProxy {w args} {
  47. if {[lindex $args 0] eq "cget" &&
  48. [lindex $args 1] eq "-takefocus"
  49. } then {
  50. return 0
  51. }
  52. uplevel 1 [linsert $args 0 $w]
  53. }
  54. }
  55.  
  56. # create a toplevel with a background ttk::frame
  57. proc ttk::toplevel {path args} {
  58. ::toplevel $path {*}$args
  59. while 1 {
  60. set bw ${path}.background#[incr i]
  61. if {![winfo exists $bw]} break
  62. }
  63. place [frame $bw] -x 0 -y 0 -relwidth 1.0 -relheight 1.0
  64. return $path
  65. }