panedwindow.tcl 5.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194
  1. # panedwindow.tcl --
  2. #
  3. # This file defines the default bindings for Tk panedwindow widgets and
  4. # provides procedures that help in implementing those bindings.
  5. bind Panedwindow <Button-1> { ::tk::panedwindow::MarkSash %W %x %y 1 }
  6. bind Panedwindow <Button-2> { ::tk::panedwindow::MarkSash %W %x %y 0 }
  7. bind Panedwindow <B1-Motion> { ::tk::panedwindow::DragSash %W %x %y 1 }
  8. bind Panedwindow <B2-Motion> { ::tk::panedwindow::DragSash %W %x %y 0 }
  9. bind Panedwindow <ButtonRelease-1> {::tk::panedwindow::ReleaseSash %W 1}
  10. bind Panedwindow <ButtonRelease-2> {::tk::panedwindow::ReleaseSash %W 0}
  11. bind Panedwindow <Motion> { ::tk::panedwindow::Motion %W %x %y }
  12. bind Panedwindow <Leave> { ::tk::panedwindow::Leave %W }
  13. # Initialize namespace
  14. namespace eval ::tk::panedwindow {}
  15. # ::tk::panedwindow::MarkSash --
  16. #
  17. # Handle marking the correct sash for possible dragging
  18. #
  19. # Arguments:
  20. # w the widget
  21. # x widget local x coord
  22. # y widget local y coord
  23. # proxy whether this should be a proxy sash
  24. # Results:
  25. # None
  26. #
  27. proc ::tk::panedwindow::MarkSash {w x y proxy} {
  28. variable ::tk::Priv
  29. if {[$w cget -opaqueresize]} {
  30. set proxy 0
  31. }
  32. set what [$w identify $x $y]
  33. if { [llength $what] == 2 } {
  34. lassign $what index which
  35. if {!$::tk_strictMotif || $which eq "handle"} {
  36. if {!$proxy} {
  37. $w sash mark $index $x $y
  38. }
  39. set Priv(sash) $index
  40. lassign [$w sash coord $index] sx sy
  41. set Priv(dx) [expr {$sx-$x}]
  42. set Priv(dy) [expr {$sy-$y}]
  43. # Do this to init the proxy location
  44. DragSash $w $x $y $proxy
  45. }
  46. }
  47. }
  48. # ::tk::panedwindow::DragSash --
  49. #
  50. # Handle dragging of the correct sash
  51. #
  52. # Arguments:
  53. # w the widget
  54. # x widget local x coord
  55. # y widget local y coord
  56. # proxy whether this should be a proxy sash
  57. # Results:
  58. # Moves sash
  59. #
  60. proc ::tk::panedwindow::DragSash {w x y proxy} {
  61. variable ::tk::Priv
  62. if {[$w cget -opaqueresize]} {
  63. set proxy 0
  64. }
  65. if {[info exists Priv(sash)]} {
  66. if {$proxy} {
  67. $w proxy place [expr {$x+$Priv(dx)}] [expr {$y+$Priv(dy)}]
  68. } else {
  69. $w sash place $Priv(sash) \
  70. [expr {$x+$Priv(dx)}] [expr {$y+$Priv(dy)}]
  71. }
  72. }
  73. }
  74. # ::tk::panedwindow::ReleaseSash --
  75. #
  76. # Handle releasing of the sash
  77. #
  78. # Arguments:
  79. # w the widget
  80. # proxy whether this should be a proxy sash
  81. # Results:
  82. # Returns ...
  83. #
  84. proc ::tk::panedwindow::ReleaseSash {w proxy} {
  85. variable ::tk::Priv
  86. if {[$w cget -opaqueresize]} {
  87. set proxy 0
  88. }
  89. if {[info exists Priv(sash)]} {
  90. if {$proxy} {
  91. lassign [$w proxy coord] x y
  92. $w sash place $Priv(sash) $x $y
  93. $w proxy forget
  94. }
  95. unset Priv(sash) Priv(dx) Priv(dy)
  96. }
  97. }
  98. # ::tk::panedwindow::Motion --
  99. #
  100. # Handle motion on the widget. This is used to change the cursor
  101. # when the user moves over the sash area.
  102. #
  103. # Arguments:
  104. # w the widget
  105. # x widget local x coord
  106. # y widget local y coord
  107. # Results:
  108. # May change the cursor. Sets up a timer to verify that we are still
  109. # over the widget.
  110. #
  111. proc ::tk::panedwindow::Motion {w x y} {
  112. variable ::tk::Priv
  113. set id [$w identify $x $y]
  114. if {([llength $id] == 2) && \
  115. (!$::tk_strictMotif || [lindex $id 1] eq "handle")} {
  116. if {![info exists Priv($w,panecursor)]} {
  117. set Priv($w,panecursor) [$w cget -cursor]
  118. if {[$w cget -sashcursor] ne ""} {
  119. $w configure -cursor [$w cget -sashcursor]
  120. } elseif {[$w cget -orient] eq "horizontal"} {
  121. $w configure -cursor sb_h_double_arrow
  122. } else {
  123. $w configure -cursor sb_v_double_arrow
  124. }
  125. if {[info exists Priv($w,pwAfterId)]} {
  126. after cancel $Priv($w,pwAfterId)
  127. }
  128. set Priv($w,pwAfterId) [after 150 \
  129. [list ::tk::panedwindow::Cursor $w]]
  130. }
  131. return
  132. }
  133. if {[info exists Priv($w,panecursor)]} {
  134. $w configure -cursor $Priv($w,panecursor)
  135. unset Priv($w,panecursor)
  136. }
  137. }
  138. # ::tk::panedwindow::Cursor --
  139. #
  140. # Handles returning the normal cursor when we are no longer over the
  141. # sash area. This needs to be done this way, because the panedwindow
  142. # won't see Leave events when the mouse moves from the sash to a
  143. # paned child, although the child does receive an Enter event.
  144. #
  145. # Arguments:
  146. # w the widget
  147. # Results:
  148. # May restore the default cursor, or schedule a timer to do it.
  149. #
  150. proc ::tk::panedwindow::Cursor {w} {
  151. variable ::tk::Priv
  152. # Make sure to check window existence in case it is destroyed.
  153. if {[info exists Priv($w,panecursor)] && [winfo exists $w]} {
  154. if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] eq $w} {
  155. set Priv($w,pwAfterId) [after 150 \
  156. [list ::tk::panedwindow::Cursor $w]]
  157. } else {
  158. $w configure -cursor $Priv($w,panecursor)
  159. unset Priv($w,panecursor)
  160. if {[info exists Priv($w,pwAfterId)]} {
  161. after cancel $Priv($w,pwAfterId)
  162. unset Priv($w,pwAfterId)
  163. }
  164. }
  165. }
  166. }
  167. # ::tk::panedwindow::Leave --
  168. #
  169. # Return to default cursor when leaving the pw widget.
  170. #
  171. # Arguments:
  172. # w the widget
  173. # Results:
  174. # Restores the default cursor
  175. #
  176. proc ::tk::panedwindow::Leave {w} {
  177. variable ::tk::Priv
  178. if {[info exists Priv($w,panecursor)]} {
  179. $w configure -cursor $Priv($w,panecursor)
  180. unset Priv($w,panecursor)
  181. }
  182. }