Install Subversion 1.6.3
[msysgit.git] / mingw / lib / tk8.5 / panedwindow.tcl
blobf1f9f9af5cf9f36b891517e17b6b223996fa86e9
1 # panedwindow.tcl --
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
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
37 proc ::tk::panedwindow::MarkSash {w x y proxy} {
38 variable ::tk::Priv
39 if {[$w cget -opaqueresize]} {
40 set proxy 0
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
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
59 # ::tk::panedwindow::DragSash --
61 # Handle dragging of the correct sash
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
71 proc ::tk::panedwindow::DragSash {w x y proxy} {
72 variable ::tk::Priv
73 if {[$w cget -opaqueresize]} {
74 set proxy 0
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)}]
86 # ::tk::panedwindow::ReleaseSash --
88 # Handle releasing of the sash
90 # Arguments:
91 # w the widget
92 # proxy whether this should be a proxy sash
93 # Results:
94 # Returns ...
96 proc ::tk::panedwindow::ReleaseSash {w proxy} {
97 variable ::tk::Priv
98 if {[$w cget -opaqueresize]} {
99 set proxy 0
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
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.
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.
124 proc ::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
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]]
144 return
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.
159 # Arguments:
160 # w the widget
161 # Results:
162 # May restore the default cursor, or schedule a timer to do it.
164 proc ::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)
182 # ::tk::panedwindow::Leave --
184 # Return to default cursor when leaving the pw widget.
186 # Arguments:
187 # w the widget
188 # Results:
189 # Restores the default cursor
191 proc ::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)