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