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