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  bind Panedwindow <Button-1> { ::tk::panedwindow::MarkSash %W %x %y 1 }
  7  bind Panedwindow <Button-2> { ::tk::panedwindow::MarkSash %W %x %y 0 }
  8  
  9  bind Panedwindow <B1-Motion> { ::tk::panedwindow::DragSash %W %x %y 1 }
 10  bind Panedwindow <B2-Motion> { ::tk::panedwindow::DragSash %W %x %y 0 }
 11  
 12  bind Panedwindow <ButtonRelease-1> {::tk::panedwindow::ReleaseSash %W 1}
 13  bind Panedwindow <ButtonRelease-2> {::tk::panedwindow::ReleaseSash %W 0}
 14  
 15  bind Panedwindow <Motion> { ::tk::panedwindow::Motion %W %x %y }
 16  
 17  bind Panedwindow <Leave> { ::tk::panedwindow::Leave %W }
 18  
 19  # Initialize namespace
 20  namespace eval ::tk::panedwindow {}
 21  
 22  # ::tk::panedwindow::MarkSash --
 23  #
 24  #   Handle marking the correct sash for possible dragging
 25  #
 26  # Arguments:
 27  #   w		the widget
 28  #   x		widget local x coord
 29  #   y		widget local y coord
 30  #   proxy	whether this should be a proxy sash
 31  # Results:
 32  #   None
 33  #
 34  proc ::tk::panedwindow::MarkSash {w x y proxy} {
 35      variable ::tk::Priv
 36      if {[$w cget -opaqueresize]} {
 37  	set proxy 0
 38      }
 39      set what [$w identify $x $y]
 40      if { [llength $what] == 2 } {
 41  	lassign $what index which
 42  	if {!$::tk_strictMotif || $which eq "handle"} {
 43  	    if {!$proxy} {
 44  		$w sash mark $index $x $y
 45  	    }
 46  	    set Priv(sash) $index
 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
 52  	}
 53      }
 54  }
 55  
 56  # ::tk::panedwindow::DragSash --
 57  #
 58  #   Handle dragging of the correct sash
 59  #
 60  # Arguments:
 61  #   w		the widget
 62  #   x		widget local x coord
 63  #   y		widget local y coord
 64  #   proxy	whether this should be a proxy sash
 65  # Results:
 66  #   Moves sash
 67  #
 68  proc ::tk::panedwindow::DragSash {w x y proxy} {
 69      variable ::tk::Priv
 70      if {[$w cget -opaqueresize]} {
 71  	set proxy 0
 72      }
 73      if {[info exists Priv(sash)]} {
 74  	if {$proxy} {
 75  	    $w proxy place [expr {$x+$Priv(dx)}] [expr {$y+$Priv(dy)}]
 76  	} else {
 77  	    $w sash place $Priv(sash) \
 78  		    [expr {$x+$Priv(dx)}] [expr {$y+$Priv(dy)}]
 79  	}
 80      }
 81  }
 82  
 83  # ::tk::panedwindow::ReleaseSash --
 84  #
 85  #   Handle releasing of the sash
 86  #
 87  # Arguments:
 88  #   w		the widget
 89  #   proxy	whether this should be a proxy sash
 90  # Results:
 91  #   Returns ...
 92  #
 93  proc ::tk::panedwindow::ReleaseSash {w proxy} {
 94      variable ::tk::Priv
 95      if {[$w cget -opaqueresize]} {
 96  	set proxy 0
 97      }
 98      if {[info exists Priv(sash)]} {
 99  	if {$proxy} {
100  	    lassign [$w proxy coord] x y
101  	    $w sash place $Priv(sash) $x $y
102  	    $w proxy forget
103  	}
104  	unset Priv(sash) Priv(dx) Priv(dy)
105      }
106  }
107  
108  # ::tk::panedwindow::Motion --
109  #
110  #   Handle motion on the widget.  This is used to change the cursor
111  #   when the user moves over the sash area.
112  #
113  # Arguments:
114  #   w		the widget
115  #   x		widget local x coord
116  #   y		widget local y coord
117  # Results:
118  #   May change the cursor.  Sets up a timer to verify that we are still
119  #   over the widget.
120  #
121  proc ::tk::panedwindow::Motion {w x y} {
122      variable ::tk::Priv
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
132  	    } else {
133  		$w configure -cursor sb_v_double_arrow
134  	    }
135  	    if {[info exists Priv($w,pwAfterId)]} {
136  		after cancel $Priv($w,pwAfterId)
137  	    }
138  	    set Priv($w,pwAfterId) [after 150 \
139  		    [list ::tk::panedwindow::Cursor $w]]
140  	}
141  	return
142      }
143      if {[info exists Priv($w,panecursor)]} {
144  	$w configure -cursor $Priv($w,panecursor)
145  	unset Priv($w,panecursor)
146      }
147  }
148  
149  # ::tk::panedwindow::Cursor --
150  #
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.
155  #
156  # Arguments:
157  #   w		the widget
158  # Results:
159  #   May restore the default cursor, or schedule a timer to do it.
160  #
161  proc ::tk::panedwindow::Cursor {w} {
162      variable ::tk::Priv
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]]
168  	} else {
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)
174  	    }
175  	}
176      }
177  }
178  
179  # ::tk::panedwindow::Leave --
180  #
181  #   Return to default cursor when leaving the pw widget.
182  #
183  # Arguments:
184  #   w		the widget
185  # Results:
186  #   Restores the default cursor
187  #
188  proc ::tk::panedwindow::Leave {w} {
189      variable ::tk::Priv
190      if {[info exists Priv($w,panecursor)]} {
191          $w configure -cursor $Priv($w,panecursor)
192          unset Priv($w,panecursor)
193      }
194  }