diff options
Diffstat (limited to 'tk8.6/library/panedwindow.tcl')
-rw-r--r-- | tk8.6/library/panedwindow.tcl | 194 |
1 files changed, 194 insertions, 0 deletions
diff --git a/tk8.6/library/panedwindow.tcl b/tk8.6/library/panedwindow.tcl new file mode 100644 index 0000000..d3dfabc --- /dev/null +++ b/tk8.6/library/panedwindow.tcl @@ -0,0 +1,194 @@ +# 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) + } +} |