3 # This file defines the default bindings for Tk panedwindow widgets and
4 # provides procedures that help in implementing those bindings.
6 # RCS: @(#) $Id: panedwindow.tcl,v 1.11 2005/07/25 09:06:00 dkf Exp $
9 bind Panedwindow
<Button-1
> { ::tk::panedwindow::MarkSash %W
%x
%y
1 }
10 bind Panedwindow
<Button-2
> { ::tk::panedwindow::MarkSash %W
%x
%y
0 }
12 bind Panedwindow
<B1-Motion
> { ::tk::panedwindow::DragSash %W
%x
%y
1 }
13 bind Panedwindow
<B2-Motion
> { ::tk::panedwindow::DragSash %W
%x
%y
0 }
15 bind Panedwindow
<ButtonRelease-1
> {::tk::panedwindow::ReleaseSash %W
1}
16 bind Panedwindow
<ButtonRelease-2
> {::tk::panedwindow::ReleaseSash %W
0}
18 bind Panedwindow
<Motion
> { ::tk::panedwindow::Motion %W
%x
%y
}
20 bind Panedwindow
<Leave
> { ::tk::panedwindow::Leave %W
}
22 # Initialize namespace
23 namespace eval ::tk::panedwindow {}
25 # ::tk::panedwindow::MarkSash --
27 # Handle marking the correct sash for possible dragging
31 # x widget local x coord
32 # y widget local y coord
33 # proxy whether this should be a proxy sash
37 proc ::tk::panedwindow::MarkSash {w x y proxy
} {
39 if {[$w cget
-opaqueresize]} {
42 set what
[$w identify
$x $y]
43 if { [llength $what] == 2 } {
44 lassign
$what index which
45 if {!$::tk_strictMotif ||
$which eq
"handle"} {
47 $w sash mark
$index $x $y
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
59 # ::tk::panedwindow::DragSash --
61 # Handle dragging of the correct sash
65 # x widget local x coord
66 # y widget local y coord
67 # proxy whether this should be a proxy sash
71 proc ::tk::panedwindow::DragSash {w x y proxy
} {
73 if {[$w cget
-opaqueresize]} {
76 if {[info exists Priv
(sash
)]} {
78 $w proxy
place [expr {$x+$Priv(dx
)}] [expr {$y+$Priv(dy
)}]
80 $w sash
place $Priv(sash
) \
81 [expr {$x+$Priv(dx
)}] [expr {$y+$Priv(dy
)}]
86 # ::tk::panedwindow::ReleaseSash --
88 # Handle releasing of the sash
92 # proxy whether this should be a proxy sash
96 proc ::tk::panedwindow::ReleaseSash {w proxy
} {
98 if {[$w cget
-opaqueresize]} {
101 if {[info exists Priv
(sash
)]} {
103 lassign
[$w proxy coord
] x y
104 $w sash
place $Priv(sash
) $x $y
107 unset Priv
(sash
) Priv
(dx
) Priv
(dy
)
111 # ::tk::panedwindow::Motion --
113 # Handle motion on the widget. This is used to change the cursor
114 # when the user moves over the sash area.
118 # x widget local x coord
119 # y widget local y coord
121 # May change the cursor. Sets up a timer to verify that we are still
124 proc ::tk::panedwindow::Motion {w x y
} {
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
136 $w configure
-cursor sb_v_double_arrow
138 if {[info exists Priv
($w,pwAfterId
)]} {
139 after cancel
$Priv($w,pwAfterId
)
141 set Priv
($w,pwAfterId
) [after 150 \
142 [list ::tk::panedwindow::Cursor $w]]
146 if {[info exists Priv
($w,panecursor
)]} {
147 $w configure
-cursor $Priv($w,panecursor
)
148 unset Priv
($w,panecursor
)
152 # ::tk::panedwindow::Cursor --
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.
162 # May restore the default cursor, or schedule a timer to do it.
164 proc ::tk::panedwindow::Cursor {w
} {
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]]
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
)
182 # ::tk::panedwindow::Leave --
184 # Return to default cursor when leaving the pw widget.
189 # Restores the default cursor
191 proc ::tk::panedwindow::Leave {w
} {
193 if {[info exists Priv
($w,panecursor
)]} {
194 $w configure
-cursor $Priv($w,panecursor
)
195 unset Priv
($w,panecursor
)