[37] | 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 | } |
---|