3 # This file defines the default bindings for Tk panedwindow widgets and
4 # provides procedures that help in implementing those bindings.
6 bind Panedwindow
<Button-1
> { ::tk::panedwindow::MarkSash %W
%x
%y
1 }
7 bind Panedwindow
<Button-2
> { ::tk::panedwindow::MarkSash %W
%x
%y
0 }
9 bind Panedwindow
<B1-Motion
> { ::tk::panedwindow::DragSash %W
%x
%y
1 }
10 bind Panedwindow
<B2-Motion
> { ::tk::panedwindow::DragSash %W
%x
%y
0 }
12 bind Panedwindow
<ButtonRelease-1
> {::tk::panedwindow::ReleaseSash %W
1}
13 bind Panedwindow
<ButtonRelease-2
> {::tk::panedwindow::ReleaseSash %W
0}
15 bind Panedwindow
<Motion
> { ::tk::panedwindow::Motion %W
%x
%y
}
17 bind Panedwindow
<Leave
> { ::tk::panedwindow::Leave %W
}
19 # Initialize namespace
20 namespace eval ::tk::panedwindow {}
22 # ::tk::panedwindow::MarkSash --
24 # Handle marking the correct sash for possible dragging
28 # x widget local x coord
29 # y widget local y coord
30 # proxy whether this should be a proxy sash
34 proc ::tk::panedwindow::MarkSash {w x y proxy
} {
36 if {[$w cget
-opaqueresize]} {
39 set what
[$w identify
$x $y]
40 if { [llength $what] == 2 } {
41 lassign
$what index which
42 if {!$::tk_strictMotif ||
$which eq
"handle"} {
44 $w sash mark
$index $x $y
47 lassign
[$w sash coord
$index] sx sy
48 set Priv
(dx
) [expr {$sx-$x}]
49 set Priv
(dy
) [expr {$sy-$y}]
50 # Do this to init the proxy location
51 DragSash
$w $x $y $proxy
56 # ::tk::panedwindow::DragSash --
58 # Handle dragging of the correct sash
62 # x widget local x coord
63 # y widget local y coord
64 # proxy whether this should be a proxy sash
68 proc ::tk::panedwindow::DragSash {w x y proxy
} {
70 if {[$w cget
-opaqueresize]} {
73 if {[info exists Priv
(sash
)]} {
75 $w proxy
place [expr {$x+$Priv(dx
)}] [expr {$y+$Priv(dy
)}]
77 $w sash
place $Priv(sash
) \
78 [expr {$x+$Priv(dx
)}] [expr {$y+$Priv(dy
)}]
83 # ::tk::panedwindow::ReleaseSash --
85 # Handle releasing of the sash
89 # proxy whether this should be a proxy sash
93 proc ::tk::panedwindow::ReleaseSash {w proxy
} {
95 if {[$w cget
-opaqueresize]} {
98 if {[info exists Priv
(sash
)]} {
100 lassign
[$w proxy coord
] x y
101 $w sash
place $Priv(sash
) $x $y
104 unset Priv
(sash
) Priv
(dx
) Priv
(dy
)
108 # ::tk::panedwindow::Motion --
110 # Handle motion on the widget. This is used to change the cursor
111 # when the user moves over the sash area.
115 # x widget local x coord
116 # y widget local y coord
118 # May change the cursor. Sets up a timer to verify that we are still
121 proc ::tk::panedwindow::Motion {w x y
} {
123 set id
[$w identify
$x $y]
124 if {([llength $id] == 2) && \
125 (!$::tk_strictMotif ||
[lindex $id 1] eq
"handle")} {
126 if {![info exists Priv
($w,panecursor
)]} {
127 set Priv
($w,panecursor
) [$w cget
-cursor]
128 if {[$w cget
-sashcursor] ne
""} {
129 $w configure
-cursor [$w cget
-sashcursor]
130 } elseif
{[$w cget
-orient] eq
"horizontal"} {
131 $w configure
-cursor sb_h_double_arrow
133 $w configure
-cursor sb_v_double_arrow
135 if {[info exists Priv
($w,pwAfterId
)]} {
136 after cancel
$Priv($w,pwAfterId
)
138 set Priv
($w,pwAfterId
) [after 150 \
139 [list ::tk::panedwindow::Cursor $w]]
143 if {[info exists Priv
($w,panecursor
)]} {
144 $w configure
-cursor $Priv($w,panecursor
)
145 unset Priv
($w,panecursor
)
149 # ::tk::panedwindow::Cursor --
151 # Handles returning the normal cursor when we are no longer over the
152 # sash area. This needs to be done this way, because the panedwindow
153 # won't see Leave events when the mouse moves from the sash to a
154 # paned child, although the child does receive an Enter event.
159 # May restore the default cursor, or schedule a timer to do it.
161 proc ::tk::panedwindow::Cursor {w
} {
163 # Make sure to check window existence in case it is destroyed.
164 if {[info exists Priv
($w,panecursor
)] && [winfo exists
$w]} {
165 if {[winfo containing
[winfo pointerx
$w] [winfo pointery
$w]] eq
$w} {
166 set Priv
($w,pwAfterId
) [after 150 \
167 [list ::tk::panedwindow::Cursor $w]]
169 $w configure
-cursor $Priv($w,panecursor
)
170 unset Priv
($w,panecursor
)
171 if {[info exists Priv
($w,pwAfterId
)]} {
172 after cancel
$Priv($w,pwAfterId
)
173 unset Priv
($w,pwAfterId
)
179 # ::tk::panedwindow::Leave --
181 # Return to default cursor when leaving the pw widget.
186 # Restores the default cursor
188 proc ::tk::panedwindow::Leave {w
} {
190 if {[info exists Priv
($w,panecursor
)]} {
191 $w configure
-cursor $Priv($w,panecursor
)
192 unset Priv
($w,panecursor
)