home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / panedwindow.tcl < prev    next >
Text File  |  2003-09-01  |  5KB  |  182 lines
  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. #
  6. # RCS: @(#) $Id: panedwindow.tcl,v 1.3 2003/01/21 20:24:46 hunt Exp $
  7. #
  8.  
  9. bind Panedwindow <Button-1> { ::tk::panedwindow::MarkSash %W %x %y 1 }
  10. bind Panedwindow <Button-2> { ::tk::panedwindow::MarkSash %W %x %y 0 }
  11.  
  12. bind Panedwindow <B1-Motion> { ::tk::panedwindow::DragSash %W %x %y 1 }
  13. bind Panedwindow <B2-Motion> { ::tk::panedwindow::DragSash %W %x %y 0 }
  14.  
  15. bind Panedwindow <ButtonRelease-1> {::tk::panedwindow::ReleaseSash %W 1}
  16. bind Panedwindow <ButtonRelease-2> {::tk::panedwindow::ReleaseSash %W 0}
  17.  
  18. bind Panedwindow <Motion> { ::tk::panedwindow::Motion %W %x %y }
  19.  
  20. bind Panedwindow <Leave> { ::tk::panedwindow::Leave %W }
  21.  
  22. # Initialize namespace
  23. namespace eval ::tk::panedwindow {}
  24.  
  25. # ::tk::panedwindow::MarkSash --
  26. #
  27. #   Handle marking the correct sash for possible dragging
  28. #
  29. # Arguments:
  30. #   w        the widget
  31. #   x        widget local x coord
  32. #   y        widget local y coord
  33. #   proxy    whether this should be a proxy sash
  34. # Results:
  35. #   None
  36. #
  37. proc ::tk::panedwindow::MarkSash {w x y proxy} {
  38.     set what [$w identify $x $y]
  39.     if { [llength $what] == 2 } {
  40.     foreach {index which} $what break
  41.     if { !$::tk_strictMotif || [string equal $which "handle"] } {
  42.         if {!$proxy} { $w sash mark $index $x $y }
  43.         set ::tk::Priv(sash) $index
  44.         foreach {sx sy} [$w sash coord $index] break
  45.         set ::tk::Priv(dx) [expr {$sx-$x}]
  46.         set ::tk::Priv(dy) [expr {$sy-$y}]
  47.     }
  48.     }
  49. }
  50.  
  51. # ::tk::panedwindow::DragSash --
  52. #
  53. #   Handle dragging of the correct sash
  54. #
  55. # Arguments:
  56. #   w        the widget
  57. #   x        widget local x coord
  58. #   y        widget local y coord
  59. #   proxy    whether this should be a proxy sash
  60. # Results:
  61. #   Moves sash
  62. #
  63. proc ::tk::panedwindow::DragSash {w x y proxy} {
  64.     if { [info exists ::tk::Priv(sash)] } {
  65.     if {$proxy} {
  66.         $w proxy place \
  67.             [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}]
  68.     } else {
  69.         $w sash place $::tk::Priv(sash) \
  70.             [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}]
  71.     }
  72.     }
  73. }
  74.  
  75. # ::tk::panedwindow::ReleaseSash --
  76. #
  77. #   Handle releasing of the sash
  78. #
  79. # Arguments:
  80. #   w        the widget
  81. #   proxy    whether this should be a proxy sash
  82. # Results:
  83. #   Returns ...
  84. #
  85. proc ::tk::panedwindow::ReleaseSash {w proxy} {
  86.     if { [info exists ::tk::Priv(sash)] } {
  87.     if {$proxy} {
  88.         foreach {x y} [$w proxy coord] break
  89.         $w sash place $::tk::Priv(sash) $x $y
  90.         $w proxy forget
  91.     }
  92.     unset ::tk::Priv(sash) ::tk::Priv(dx) ::tk::Priv(dy)
  93.     }
  94. }
  95.  
  96. # ::tk::panedwindow::Motion --
  97. #
  98. #   Handle motion on the widget.  This is used to change the cursor
  99. #   when the user moves over the sash area.
  100. #
  101. # Arguments:
  102. #   w        the widget
  103. #   x        widget local x coord
  104. #   y        widget local y coord
  105. # Results:
  106. #   May change the cursor.  Sets up a timer to verify that we are still
  107. #   over the widget.
  108. #
  109. proc ::tk::panedwindow::Motion {w x y} {
  110.     variable ::tk::Priv
  111.     set id [$w identify $x $y]
  112.     if {([llength $id] == 2) && \
  113.         (!$::tk_strictMotif || [string equal [lindex $id 1] "handle"])} {
  114.     if { ![info exists Priv(panecursor)] } {
  115.         set Priv(panecursor) [$w cget -cursor]
  116.         if { [string equal [$w cget -sashcursor] ""] } {
  117.         if { [string equal [$w cget -orient] "horizontal"] } {
  118.             $w configure -cursor sb_h_double_arrow
  119.         } else {
  120.             $w configure -cursor sb_v_double_arrow
  121.         }
  122.         } else {
  123.         $w configure -cursor [$w cget -sashcursor]
  124.         }
  125.         if {[info exists Priv(pwAfterId)]} {
  126.         after cancel $Priv(pwAfterId)
  127.         }
  128.         set Priv(pwAfterId) [after 150 \
  129.             [list ::tk::panedwindow::Cursor $w]]
  130.     }
  131.     return
  132.     }
  133.     if { [info exists Priv(panecursor)] } {
  134.     $w configure -cursor $Priv(panecursor)
  135.     unset Priv(panecursor)
  136.     }
  137. }
  138.  
  139. # ::tk::panedwindow::Cursor --
  140. #
  141. #   Handles returning the normal cursor when we are no longer over the
  142. #   sash area.  This needs to be done this way, because the panedwindow
  143. #   won't see Leave events when the mouse moves from the sash to a
  144. #   paned child, although the child does receive an Enter event.
  145. #
  146. # Arguments:
  147. #   w        the widget
  148. # Results:
  149. #   May restore the default cursor, or schedule a timer to do it.
  150. #
  151. proc ::tk::panedwindow::Cursor {w} {
  152.     variable ::tk::Priv
  153.     if {[info exists Priv(panecursor)]} {
  154.     if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] == $w} {
  155.         set Priv(pwAfterId) [after 150 [list ::tk::panedwindow::Cursor $w]]
  156.     } else {
  157.         $w configure -cursor $Priv(panecursor)
  158.         unset Priv(panecursor)
  159.         if {[info exists Priv(pwAfterId)]} {
  160.         after cancel $Priv(pwAfterId)
  161.         unset Priv(pwAfterId)
  162.         }
  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.     if {[info exists ::tk::Priv(panecursor)]} {
  178.         $w configure -cursor $::tk::Priv(panecursor)
  179.         unset ::tk::Priv(panecursor)
  180.     }
  181. }
  182.