lib/tk8.4/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.6.2.4 2006/01/25 18:21:41 dgp 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     if {[$w cget -opaqueresize]} { set proxy 0 }
  39     set what [$w identify $x $y]
  40     if { [llength $what] == 2 } {
  41         foreach {index which} $what break
  42         if { !$::tk_strictMotif || $which eq "handle" } {
  43             if {!$proxy} { $w sash mark $index $x $y }
  44             set ::tk::Priv(sash) $index
  45             foreach {sx sy} [$w sash coord $index] break
  46             set ::tk::Priv(dx) [expr {$sx-$x}]
  47             set ::tk::Priv(dy) [expr {$sy-$y}]
  48             # Do this to init the proxy location
  49             DragSash $w $x $y $proxy
  50         }
  51     }
  52 }
  53
  54 # ::tk::panedwindow::DragSash --
  55 #
  56 #   Handle dragging of the correct sash
  57 #
  58 # Arguments:
  59 #   w           the widget
  60 #   x           widget local x coord
  61 #   y           widget local y coord
  62 #   proxy       whether this should be a proxy sash
  63 # Results:
  64 #   Moves sash
  65 #
  66 proc ::tk::panedwindow::DragSash {w x y proxy} {
  67     if {[$w cget -opaqueresize]} { set proxy 0 }
  68     if { [info exists ::tk::Priv(sash)] } {
  69         if {$proxy} {
  70             $w proxy place \
  71                     [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}]
  72         } else {
  73             $w sash place $::tk::Priv(sash) \
  74                     [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}]
  75         }
  76     }
  77 }
  78
  79 # ::tk::panedwindow::ReleaseSash --
  80 #
  81 #   Handle releasing of the sash
  82 #
  83 # Arguments:
  84 #   w           the widget
  85 #   proxy       whether this should be a proxy sash
  86 # Results:
  87 #   Returns ...
  88 #
  89 proc ::tk::panedwindow::ReleaseSash {w proxy} {
  90     if {[$w cget -opaqueresize]} { set proxy 0 }
  91     if { [info exists ::tk::Priv(sash)] } {
  92         if {$proxy} {
  93             foreach {x y} [$w proxy coord] break
  94             $w sash place $::tk::Priv(sash) $x $y
  95             $w proxy forget
  96         }
  97         unset ::tk::Priv(sash) ::tk::Priv(dx) ::tk::Priv(dy)
  98     }
  99 }
 100
 101 # ::tk::panedwindow::Motion --
 102 #
 103 #   Handle motion on the widget.  This is used to change the cursor
 104 #   when the user moves over the sash area.
 105 #
 106 # Arguments:
 107 #   w           the widget
 108 #   x           widget local x coord
 109 #   y           widget local y coord
 110 # Results:
 111 #   May change the cursor.  Sets up a timer to verify that we are still
 112 #   over the widget.
 113 #
 114 proc ::tk::panedwindow::Motion {w x y} {
 115     variable ::tk::Priv
 116     set id [$w identify $x $y]
 117     if {([llength $id] == 2) && \
 118             (!$::tk_strictMotif || [lindex $id 1] eq "handle")} {
 119         if { ![info exists Priv($w,panecursor)] } {
 120             set Priv($w,panecursor) [$w cget -cursor]
 121             if { [$w cget -sashcursor] eq "" } {
 122                 if { [$w cget -orient] eq "horizontal" } {
 123                     $w configure -cursor sb_h_double_arrow
 124                 } else {
 125                     $w configure -cursor sb_v_double_arrow
 126                 }
 127             } else {
 128                 $w configure -cursor [$w cget -sashcursor]
 129             }
 130             if {[info exists Priv($w,pwAfterId)]} {
 131                 after cancel $Priv($w,pwAfterId)
 132             }
 133             set Priv($w,pwAfterId) [after 150 \
 134                     [list ::tk::panedwindow::Cursor $w]]
 135         }
 136         return
 137     }
 138     if { [info exists Priv($w,panecursor)] } {
 139         $w configure -cursor $Priv($w,panecursor)
 140         unset Priv($w,panecursor)
 141     }
 142 }
 143
 144 # ::tk::panedwindow::Cursor --
 145 #
 146 #   Handles returning the normal cursor when we are no longer over the
 147 #   sash area.  This needs to be done this way, because the panedwindow
 148 #   won't see Leave events when the mouse moves from the sash to a
 149 #   paned child, although the child does receive an Enter event.
 150 #
 151 # Arguments:
 152 #   w           the widget
 153 # Results:
 154 #   May restore the default cursor, or schedule a timer to do it.
 155 #
 156 proc ::tk::panedwindow::Cursor {w} {
 157     variable ::tk::Priv
 158     # Make sure to check window existence in case it is destroyed.
 159     if {[info exists Priv($w,panecursor)] && [winfo exists $w]} {
 160         if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] eq $w} {
 161             set Priv($w,pwAfterId) [after 150 \
 162                     [list ::tk::panedwindow::Cursor $w]]
 163         } else {
 164             $w configure -cursor $Priv($w,panecursor)
 165             unset Priv($w,panecursor)
 166             if {[info exists Priv($w,pwAfterId)]} {
 167                 after cancel $Priv($w,pwAfterId)
 168                 unset Priv($w,pwAfterId)
 169             }
 170         }
 171     }
 172 }
 173
 174 # ::tk::panedwindow::Leave --
 175 #
 176 #   Return to default cursor when leaving the pw widget.
 177 #
 178 # Arguments:
 179 #   w           the widget
 180 # Results:
 181 #   Restores the default cursor
 182 #
 183 proc ::tk::panedwindow::Leave {w} {
 184     if {[info exists ::tk::Priv($w,panecursor)]} {
 185         $w configure -cursor $::tk::Priv($w,panecursor)
 186         unset ::tk::Priv($w,panecursor)
 187     }
 188 }