panedwindow.tcl (5176B)
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 }