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 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 }