panedwindow.tcl 1.9 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182
  1. #
  2. # Bindings for ttk::panedwindow widget.
  3. #
  4. namespace eval ttk::panedwindow {
  5. variable State
  6. array set State {
  7. pressed 0
  8. pressX -
  9. pressY -
  10. sash -
  11. sashPos -
  12. }
  13. }
  14. ## Bindings:
  15. #
  16. bind TPanedwindow <ButtonPress-1> { ttk::panedwindow::Press %W %x %y }
  17. bind TPanedwindow <B1-Motion> { ttk::panedwindow::Drag %W %x %y }
  18. bind TPanedwindow <ButtonRelease-1> { ttk::panedwindow::Release %W %x %y }
  19. bind TPanedwindow <Motion> { ttk::panedwindow::SetCursor %W %x %y }
  20. bind TPanedwindow <Enter> { ttk::panedwindow::SetCursor %W %x %y }
  21. bind TPanedwindow <Leave> { ttk::panedwindow::ResetCursor %W }
  22. # See <<NOTE-PW-LEAVE-NOTIFYINFERIOR>>
  23. bind TPanedwindow <<EnteredChild>> { ttk::panedwindow::ResetCursor %W }
  24. ## Sash movement:
  25. #
  26. proc ttk::panedwindow::Press {w x y} {
  27. variable State
  28. set sash [$w identify $x $y]
  29. if {$sash eq ""} {
  30. set State(pressed) 0
  31. return
  32. }
  33. set State(pressed) 1
  34. set State(pressX) $x
  35. set State(pressY) $y
  36. set State(sash) $sash
  37. set State(sashPos) [$w sashpos $sash]
  38. }
  39. proc ttk::panedwindow::Drag {w x y} {
  40. variable State
  41. if {!$State(pressed)} { return }
  42. switch -- [$w cget -orient] {
  43. horizontal { set delta [expr {$x - $State(pressX)}] }
  44. vertical { set delta [expr {$y - $State(pressY)}] }
  45. }
  46. $w sashpos $State(sash) [expr {$State(sashPos) + $delta}]
  47. }
  48. proc ttk::panedwindow::Release {w x y} {
  49. variable State
  50. set State(pressed) 0
  51. SetCursor $w $x $y
  52. }
  53. ## Cursor management:
  54. #
  55. proc ttk::panedwindow::ResetCursor {w} {
  56. variable State
  57. if {!$State(pressed)} {
  58. ttk::setCursor $w {}
  59. }
  60. }
  61. proc ttk::panedwindow::SetCursor {w x y} {
  62. set cursor ""
  63. if {[llength [$w identify $x $y]]} {
  64. # Assume we're over a sash.
  65. switch -- [$w cget -orient] {
  66. horizontal { set cursor hresize }
  67. vertical { set cursor vresize }
  68. }
  69. }
  70. ttk::setCursor $w $cursor
  71. }
  72. #*EOF*