home *** CD-ROM | disk | FTP | other *** search
/ Freelog Special Freeware 31 / FreelogHS31.iso / Texte / scribus / scribus-1.3.3.9-win32-install.exe / tcl / tk8.4 / panedwindow.tcl < prev    next >
Text File  |  2004-05-03  |  5KB  |  188 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.6.2.2 2004/05/03 19:36:56 hobbs 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.     if {[$w cget -opaqueresize]} { set proxy 0 }
  39.     set what [$w identify $x $y]
  40.     if { [llength $what] == 2 } {
  41.     foreach {index which} $what break
  42.     if { !$::tk_strictMotif || [string equal $which "handle"] } {
  43.         if {!$proxy} { $w sash mark $index $x $y }
  44.         set ::tk::Priv(sash) $index
  45.         foreach {sx sy} [$w sash coord $index] break
  46.         set ::tk::Priv(dx) [expr {$sx-$x}]
  47.         set ::tk::Priv(dy) [expr {$sy-$y}]
  48.         # Do this to init the proxy location
  49.         DragSash $w $x $y $proxy
  50.     }
  51.     }
  52. }
  53.  
  54. # ::tk::panedwindow::DragSash --
  55. #
  56. #   Handle dragging of the correct sash
  57. #
  58. # Arguments:
  59. #   w        the widget
  60. #   x        widget local x coord
  61. #   y        widget local y coord
  62. #   proxy    whether this should be a proxy sash
  63. # Results:
  64. #   Moves sash
  65. #
  66. proc ::tk::panedwindow::DragSash {w x y proxy} {
  67.     if {[$w cget -opaqueresize]} { set proxy 0 }
  68.     if { [info exists ::tk::Priv(sash)] } {
  69.     if {$proxy} {
  70.         $w proxy place \
  71.             [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}]
  72.     } else {
  73.         $w sash place $::tk::Priv(sash) \
  74.             [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}]
  75.     }
  76.     }
  77. }
  78.  
  79. # ::tk::panedwindow::ReleaseSash --
  80. #
  81. #   Handle releasing of the sash
  82. #
  83. # Arguments:
  84. #   w        the widget
  85. #   proxy    whether this should be a proxy sash
  86. # Results:
  87. #   Returns ...
  88. #
  89. proc ::tk::panedwindow::ReleaseSash {w proxy} {
  90.     if {[$w cget -opaqueresize]} { set proxy 0 }
  91.     if { [info exists ::tk::Priv(sash)] } {
  92.     if {$proxy} {
  93.         foreach {x y} [$w proxy coord] break
  94.         $w sash place $::tk::Priv(sash) $x $y
  95.         $w proxy forget
  96.     }
  97.     unset ::tk::Priv(sash) ::tk::Priv(dx) ::tk::Priv(dy)
  98.     }
  99. }
  100.  
  101. # ::tk::panedwindow::Motion --
  102. #
  103. #   Handle motion on the widget.  This is used to change the cursor
  104. #   when the user moves over the sash area.
  105. #
  106. # Arguments:
  107. #   w        the widget
  108. #   x        widget local x coord
  109. #   y        widget local y coord
  110. # Results:
  111. #   May change the cursor.  Sets up a timer to verify that we are still
  112. #   over the widget.
  113. #
  114. proc ::tk::panedwindow::Motion {w x y} {
  115.     variable ::tk::Priv
  116.     set id [$w identify $x $y]
  117.     if {([llength $id] == 2) && \
  118.         (!$::tk_strictMotif || [string equal [lindex $id 1] "handle"])} {
  119.     if { ![info exists Priv($w,panecursor)] } {
  120.         set Priv($w,panecursor) [$w cget -cursor]
  121.         if { [string equal [$w cget -sashcursor] ""] } {
  122.         if { [string equal [$w cget -orient] "horizontal"] } {
  123.             $w configure -cursor sb_h_double_arrow
  124.         } else {
  125.             $w configure -cursor sb_v_double_arrow
  126.         }
  127.         } else {
  128.         $w configure -cursor [$w cget -sashcursor]
  129.         }
  130.         if {[info exists Priv($w,pwAfterId)]} {
  131.         after cancel $Priv($w,pwAfterId)
  132.         }
  133.         set Priv($w,pwAfterId) [after 150 \
  134.             [list ::tk::panedwindow::Cursor $w]]
  135.     }
  136.     return
  137.     }
  138.     if { [info exists Priv($w,panecursor)] } {
  139.     $w configure -cursor $Priv($w,panecursor)
  140.     unset Priv($w,panecursor)
  141.     }
  142. }
  143.  
  144. # ::tk::panedwindow::Cursor --
  145. #
  146. #   Handles returning the normal cursor when we are no longer over the
  147. #   sash area.  This needs to be done this way, because the panedwindow
  148. #   won't see Leave events when the mouse moves from the sash to a
  149. #   paned child, although the child does receive an Enter event.
  150. #
  151. # Arguments:
  152. #   w        the widget
  153. # Results:
  154. #   May restore the default cursor, or schedule a timer to do it.
  155. #
  156. proc ::tk::panedwindow::Cursor {w} {
  157.     variable ::tk::Priv
  158.     if {[info exists Priv($w,panecursor)]} {
  159.     if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] eq $w} {
  160.         set Priv($w,pwAfterId) [after 150 \
  161.             [list ::tk::panedwindow::Cursor $w]]
  162.     } else {
  163.         $w configure -cursor $Priv($w,panecursor)
  164.         unset Priv($w,panecursor)
  165.         if {[info exists Priv($w,pwAfterId)]} {
  166.         after cancel $Priv($w,pwAfterId)
  167.         unset Priv($w,pwAfterId)
  168.         }
  169.     }
  170.     }
  171. }
  172.  
  173. # ::tk::panedwindow::Leave --
  174. #
  175. #   Return to default cursor when leaving the pw widget.
  176. #
  177. # Arguments:
  178. #   w        the widget
  179. # Results:
  180. #   Restores the default cursor
  181. #
  182. proc ::tk::panedwindow::Leave {w} {
  183.     if {[info exists ::tk::Priv($w,panecursor)]} {
  184.         $w configure -cursor $::tk::Priv($w,panecursor)
  185.         unset ::tk::Priv($w,panecursor)
  186.     }
  187. }
  188.