Posted to tcl by apn at Thu Jul 25 05:03:50 GMT 2024view raw

  1. From Effective Tcl/Tk book :
  2.  
  3. # ----------------------------------------------------------------------
  4. # USAGE: bind_debug <win> <state>
  5. #
  6. # Turns bind debugging on or off for a particular window <win>.
  7. # ----------------------------------------------------------------------
  8. proc bind_debug {w on} {
  9. set events {
  10. {ButtonPress {W=%W #=%# x=%x y=%y b=%b s=%s }}
  11. {ButtonRelease {W=%W #=%# x=%x y=%y b=%b s=%s }}
  12. {Circulate {W=%W #=%# x=%x y=%y p=%p }}
  13. {Colormap {W=%W #=%# x=%x y=%y }}
  14. {Configure {W=%W #=%# x=%x y=%y a=%a o=%o h=%h w=%w B=%B }}
  15. {Destroy {W=%W #=%# x=%x y=%y }}
  16. {Enter {W=%W #=%# x=%x y=%y d=%d f=%f h=%h m=%m s=%s }}
  17. {Expose {W=%W #=%# x=%x y=%y c=%c h=%h w=%w }}
  18. {FocusIn {W=%W #=%# x=%x y=%y d=%d m=%m }}
  19. {FocusOut {W=%W #=%# x=%x y=%y d=%d m=%m }}
  20. {Gravity {W=%W #=%# x=%x y=%y }}
  21. {KeyPress {W=%W #=%# x=%x y=%y k=%k s=%s A=%A K=%K N=%N }}
  22. {KeyRelease {W=%W #=%# x=%x y=%y k=%k s=%s A=%A K=%K N=%N }}
  23. {Leave {W=%W #=%# x=%x y=%y d=%d f=%f m=%m s=%s }}
  24. {Map {W=%W #=%# x=%x y=%y o=%o }}
  25. {Motion {W=%W #=%# x=%x y=%y s=%s }}
  26. {Property {W=%W #=%# x=%x y=%y }}
  27. {Reparent {W=%W #=%# x=%x y=%y o=%o }}
  28. {Unmap {W=%W #=%# x=%x y=%y }}
  29. {Visibility {W=%W #=%# x=%x y=%y s=%s }}
  30. }
  31.  
  32. foreach e $events {
  33. set type [lindex $e 0]
  34. set fmt [lindex $e 1]
  35. bind BindDebugger <$type> "puts \"<$type> $fmt\""
  36. }
  37.  
  38. set allwin [bind_debug_allwindows $w]
  39. foreach w $allwin {
  40. set tags [bindtags $w]
  41. set i [lsearch $tags BindDebugger]
  42. if {$on} {
  43. if {$i < 0} {
  44. set tags [linsert $tags 0 BindDebugger]
  45. bindtags $w $tags
  46. }
  47. } else {
  48. if {$i >= 0} {
  49. set tags [lreplace $tags $i $i]
  50. bindtags $w $tags
  51. }
  52. }
  53. }
  54. }
  55.  
  56. # ----------------------------------------------------------------------
  57. # USAGE: bind_debug_allwindows <win>
  58. #
  59. # Returns a list containing an entire tree of windows starting with
  60. # the window <win>.
  61. # ----------------------------------------------------------------------
  62. proc bind_debug_allwindows {w} {
  63. set list $w
  64. foreach i [winfo children $w] {
  65. eval lappend list [bind_debug_allwindows $i]
  66. }
  67. return $list
  68. }
  69.