| 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.3 2005/02/12 00:48:05 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 | # Make sure to check window existence in case it is destroyed. |
| 159 | if {[info exists Priv($w,panecursor)] && [winfo exists $w]} { |
| 160 | if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] eq $w} { |
| 161 | set Priv($w,pwAfterId) [after 150 \ |
| 162 | [list ::tk::panedwindow::Cursor $w]] |
| 163 | } else { |
| 164 | $w configure -cursor $Priv($w,panecursor) |
| 165 | unset Priv($w,panecursor) |
| 166 | if {[info exists Priv($w,pwAfterId)]} { |
| 167 | after cancel $Priv($w,pwAfterId) |
| 168 | unset Priv($w,pwAfterId) |
| 169 | } |
| 170 | } |
| 171 | } |
| 172 | } |
| 173 | |
| 174 | # ::tk::panedwindow::Leave -- |
| 175 | # |
| 176 | # Return to default cursor when leaving the pw widget. |
| 177 | # |
| 178 | # Arguments: |
| 179 | # w the widget |
| 180 | # Results: |
| 181 | # Restores the default cursor |
| 182 | # |
| 183 | proc ::tk::panedwindow::Leave {w} { |
| 184 | if {[info exists ::tk::Priv($w,panecursor)]} { |
| 185 | $w configure -cursor $::tk::Priv($w,panecursor) |
| 186 | unset ::tk::Priv($w,panecursor) |
| 187 | } |
| 188 | } |