123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194 |
- # panedwindow.tcl --
- #
- # This file defines the default bindings for Tk panedwindow widgets and
- # provides procedures that help in implementing those bindings.
- bind Panedwindow <Button-1> { ::tk::panedwindow::MarkSash %W %x %y 1 }
- bind Panedwindow <Button-2> { ::tk::panedwindow::MarkSash %W %x %y 0 }
- bind Panedwindow <B1-Motion> { ::tk::panedwindow::DragSash %W %x %y 1 }
- bind Panedwindow <B2-Motion> { ::tk::panedwindow::DragSash %W %x %y 0 }
- bind Panedwindow <ButtonRelease-1> {::tk::panedwindow::ReleaseSash %W 1}
- bind Panedwindow <ButtonRelease-2> {::tk::panedwindow::ReleaseSash %W 0}
- bind Panedwindow <Motion> { ::tk::panedwindow::Motion %W %x %y }
- bind Panedwindow <Leave> { ::tk::panedwindow::Leave %W }
- # Initialize namespace
- namespace eval ::tk::panedwindow {}
- # ::tk::panedwindow::MarkSash --
- #
- # Handle marking the correct sash for possible dragging
- #
- # Arguments:
- # w the widget
- # x widget local x coord
- # y widget local y coord
- # proxy whether this should be a proxy sash
- # Results:
- # None
- #
- proc ::tk::panedwindow::MarkSash {w x y proxy} {
- variable ::tk::Priv
- if {[$w cget -opaqueresize]} {
- set proxy 0
- }
- set what [$w identify $x $y]
- if { [llength $what] == 2 } {
- lassign $what index which
- if {!$::tk_strictMotif || $which eq "handle"} {
- if {!$proxy} {
- $w sash mark $index $x $y
- }
- set Priv(sash) $index
- lassign [$w sash coord $index] sx sy
- set Priv(dx) [expr {$sx-$x}]
- set Priv(dy) [expr {$sy-$y}]
- # Do this to init the proxy location
- DragSash $w $x $y $proxy
- }
- }
- }
- # ::tk::panedwindow::DragSash --
- #
- # Handle dragging of the correct sash
- #
- # Arguments:
- # w the widget
- # x widget local x coord
- # y widget local y coord
- # proxy whether this should be a proxy sash
- # Results:
- # Moves sash
- #
- proc ::tk::panedwindow::DragSash {w x y proxy} {
- variable ::tk::Priv
- if {[$w cget -opaqueresize]} {
- set proxy 0
- }
- if {[info exists Priv(sash)]} {
- if {$proxy} {
- $w proxy place [expr {$x+$Priv(dx)}] [expr {$y+$Priv(dy)}]
- } else {
- $w sash place $Priv(sash) \
- [expr {$x+$Priv(dx)}] [expr {$y+$Priv(dy)}]
- }
- }
- }
- # ::tk::panedwindow::ReleaseSash --
- #
- # Handle releasing of the sash
- #
- # Arguments:
- # w the widget
- # proxy whether this should be a proxy sash
- # Results:
- # Returns ...
- #
- proc ::tk::panedwindow::ReleaseSash {w proxy} {
- variable ::tk::Priv
- if {[$w cget -opaqueresize]} {
- set proxy 0
- }
- if {[info exists Priv(sash)]} {
- if {$proxy} {
- lassign [$w proxy coord] x y
- $w sash place $Priv(sash) $x $y
- $w proxy forget
- }
- unset Priv(sash) Priv(dx) Priv(dy)
- }
- }
- # ::tk::panedwindow::Motion --
- #
- # Handle motion on the widget. This is used to change the cursor
- # when the user moves over the sash area.
- #
- # Arguments:
- # w the widget
- # x widget local x coord
- # y widget local y coord
- # Results:
- # May change the cursor. Sets up a timer to verify that we are still
- # over the widget.
- #
- proc ::tk::panedwindow::Motion {w x y} {
- variable ::tk::Priv
- set id [$w identify $x $y]
- if {([llength $id] == 2) && \
- (!$::tk_strictMotif || [lindex $id 1] eq "handle")} {
- if {![info exists Priv($w,panecursor)]} {
- set Priv($w,panecursor) [$w cget -cursor]
- if {[$w cget -sashcursor] ne ""} {
- $w configure -cursor [$w cget -sashcursor]
- } elseif {[$w cget -orient] eq "horizontal"} {
- $w configure -cursor sb_h_double_arrow
- } else {
- $w configure -cursor sb_v_double_arrow
- }
- if {[info exists Priv($w,pwAfterId)]} {
- after cancel $Priv($w,pwAfterId)
- }
- set Priv($w,pwAfterId) [after 150 \
- [list ::tk::panedwindow::Cursor $w]]
- }
- return
- }
- if {[info exists Priv($w,panecursor)]} {
- $w configure -cursor $Priv($w,panecursor)
- unset Priv($w,panecursor)
- }
- }
- # ::tk::panedwindow::Cursor --
- #
- # Handles returning the normal cursor when we are no longer over the
- # sash area. This needs to be done this way, because the panedwindow
- # won't see Leave events when the mouse moves from the sash to a
- # paned child, although the child does receive an Enter event.
- #
- # Arguments:
- # w the widget
- # Results:
- # May restore the default cursor, or schedule a timer to do it.
- #
- proc ::tk::panedwindow::Cursor {w} {
- variable ::tk::Priv
- # Make sure to check window existence in case it is destroyed.
- if {[info exists Priv($w,panecursor)] && [winfo exists $w]} {
- if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] eq $w} {
- set Priv($w,pwAfterId) [after 150 \
- [list ::tk::panedwindow::Cursor $w]]
- } else {
- $w configure -cursor $Priv($w,panecursor)
- unset Priv($w,panecursor)
- if {[info exists Priv($w,pwAfterId)]} {
- after cancel $Priv($w,pwAfterId)
- unset Priv($w,pwAfterId)
- }
- }
- }
- }
- # ::tk::panedwindow::Leave --
- #
- # Return to default cursor when leaving the pw widget.
- #
- # Arguments:
- # w the widget
- # Results:
- # Restores the default cursor
- #
- proc ::tk::panedwindow::Leave {w} {
- variable ::tk::Priv
- if {[info exists Priv($w,panecursor)]} {
- $w configure -cursor $Priv($w,panecursor)
- unset Priv($w,panecursor)
- }
- }
|