mingw/lib/tk8.5/panedwindow.tcl

   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: panedwindow.tcl,v 1.11 2005/07/25 09:06:00 dkf Exp $
   7 #
   8
   9 bind Panedwindow <Button-1> { ::tk::panedwindow::MarkSash %W %x %y 1 }
  10 bind Panedwindow <Button-2> { ::tk::panedwindow::MarkSash %W %x %y 0 }
  11
  12 bind Panedwindow <B1-Motion> { ::tk::panedwindow::DragSash %W %x %y 1 }
  13 bind Panedwindow <B2-Motion> { ::tk::panedwindow::DragSash %W %x %y 0 }
  14
  15 bind Panedwindow <ButtonRelease-1> {::tk::panedwindow::ReleaseSash %W 1}
  16 bind Panedwindow <ButtonRelease-2> {::tk::panedwindow::ReleaseSash %W 0}
  17
  18 bind Panedwindow <Motion> { ::tk::panedwindow::Motion %W %x %y }
  19
  20 bind Panedwindow <Leave> { ::tk::panedwindow::Leave %W }
  21
  22 # Initialize namespace
  23 namespace 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 #
  37 proc ::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 #
  71 proc ::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 #
  96 proc ::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 #
 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
 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 #
 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)
 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 #
 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)
 196     }
 197 }