Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | # scrlbar.tcl -- |
2 | # | |
3 | # This file defines the default bindings for Tk scrollbar widgets. | |
4 | # It also provides procedures that help in implementing the bindings. | |
5 | # | |
6 | # RCS: @(#) $Id: scrlbar.tcl,v 1.10.2.1 2004/02/17 07:17:17 das Exp $ | |
7 | # | |
8 | # Copyright (c) 1994 The Regents of the University of California. | |
9 | # Copyright (c) 1994-1996 Sun Microsystems, Inc. | |
10 | # | |
11 | # See the file "license.terms" for information on usage and redistribution | |
12 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. | |
13 | # | |
14 | ||
15 | #------------------------------------------------------------------------- | |
16 | # The code below creates the default class bindings for scrollbars. | |
17 | #------------------------------------------------------------------------- | |
18 | ||
19 | # Standard Motif bindings: | |
20 | if {[string equal [tk windowingsystem] "x11"]} { | |
21 | ||
22 | bind Scrollbar <Enter> { | |
23 | if {$tk_strictMotif} { | |
24 | set tk::Priv(activeBg) [%W cget -activebackground] | |
25 | %W config -activebackground [%W cget -background] | |
26 | } | |
27 | %W activate [%W identify %x %y] | |
28 | } | |
29 | bind Scrollbar <Motion> { | |
30 | %W activate [%W identify %x %y] | |
31 | } | |
32 | ||
33 | # The "info exists" command in the following binding handles the | |
34 | # situation where a Leave event occurs for a scrollbar without the Enter | |
35 | # event. This seems to happen on some systems (such as Solaris 2.4) for | |
36 | # unknown reasons. | |
37 | ||
38 | bind Scrollbar <Leave> { | |
39 | if {$tk_strictMotif && [info exists tk::Priv(activeBg)]} { | |
40 | %W config -activebackground $tk::Priv(activeBg) | |
41 | } | |
42 | %W activate {} | |
43 | } | |
44 | bind Scrollbar <1> { | |
45 | tk::ScrollButtonDown %W %x %y | |
46 | } | |
47 | bind Scrollbar <B1-Motion> { | |
48 | tk::ScrollDrag %W %x %y | |
49 | } | |
50 | bind Scrollbar <B1-B2-Motion> { | |
51 | tk::ScrollDrag %W %x %y | |
52 | } | |
53 | bind Scrollbar <ButtonRelease-1> { | |
54 | tk::ScrollButtonUp %W %x %y | |
55 | } | |
56 | bind Scrollbar <B1-Leave> { | |
57 | # Prevents <Leave> binding from being invoked. | |
58 | } | |
59 | bind Scrollbar <B1-Enter> { | |
60 | # Prevents <Enter> binding from being invoked. | |
61 | } | |
62 | bind Scrollbar <2> { | |
63 | tk::ScrollButton2Down %W %x %y | |
64 | } | |
65 | bind Scrollbar <B1-2> { | |
66 | # Do nothing, since button 1 is already down. | |
67 | } | |
68 | bind Scrollbar <B2-1> { | |
69 | # Do nothing, since button 2 is already down. | |
70 | } | |
71 | bind Scrollbar <B2-Motion> { | |
72 | tk::ScrollDrag %W %x %y | |
73 | } | |
74 | bind Scrollbar <ButtonRelease-2> { | |
75 | tk::ScrollButtonUp %W %x %y | |
76 | } | |
77 | bind Scrollbar <B1-ButtonRelease-2> { | |
78 | # Do nothing: B1 release will handle it. | |
79 | } | |
80 | bind Scrollbar <B2-ButtonRelease-1> { | |
81 | # Do nothing: B2 release will handle it. | |
82 | } | |
83 | bind Scrollbar <B2-Leave> { | |
84 | # Prevents <Leave> binding from being invoked. | |
85 | } | |
86 | bind Scrollbar <B2-Enter> { | |
87 | # Prevents <Enter> binding from being invoked. | |
88 | } | |
89 | bind Scrollbar <Control-1> { | |
90 | tk::ScrollTopBottom %W %x %y | |
91 | } | |
92 | bind Scrollbar <Control-2> { | |
93 | tk::ScrollTopBottom %W %x %y | |
94 | } | |
95 | ||
96 | bind Scrollbar <Up> { | |
97 | tk::ScrollByUnits %W v -1 | |
98 | } | |
99 | bind Scrollbar <Down> { | |
100 | tk::ScrollByUnits %W v 1 | |
101 | } | |
102 | bind Scrollbar <Control-Up> { | |
103 | tk::ScrollByPages %W v -1 | |
104 | } | |
105 | bind Scrollbar <Control-Down> { | |
106 | tk::ScrollByPages %W v 1 | |
107 | } | |
108 | bind Scrollbar <Left> { | |
109 | tk::ScrollByUnits %W h -1 | |
110 | } | |
111 | bind Scrollbar <Right> { | |
112 | tk::ScrollByUnits %W h 1 | |
113 | } | |
114 | bind Scrollbar <Control-Left> { | |
115 | tk::ScrollByPages %W h -1 | |
116 | } | |
117 | bind Scrollbar <Control-Right> { | |
118 | tk::ScrollByPages %W h 1 | |
119 | } | |
120 | bind Scrollbar <Prior> { | |
121 | tk::ScrollByPages %W hv -1 | |
122 | } | |
123 | bind Scrollbar <Next> { | |
124 | tk::ScrollByPages %W hv 1 | |
125 | } | |
126 | bind Scrollbar <Home> { | |
127 | tk::ScrollToPos %W 0 | |
128 | } | |
129 | bind Scrollbar <End> { | |
130 | tk::ScrollToPos %W 1 | |
131 | } | |
132 | } | |
133 | if {[string equal [tk windowingsystem] "classic"] | |
134 | || [string equal [tk windowingsystem] "aqua"]} { | |
135 | bind Scrollbar <MouseWheel> { | |
136 | tk::ScrollByUnits %W v [expr {- (%D)}] | |
137 | } | |
138 | bind Scrollbar <Option-MouseWheel> { | |
139 | tk::ScrollByUnits %W v [expr {-10 * (%D)}] | |
140 | } | |
141 | bind Scrollbar <Shift-MouseWheel> { | |
142 | tk::ScrollByUnits %W h [expr {- (%D)}] | |
143 | } | |
144 | bind Scrollbar <Shift-Option-MouseWheel> { | |
145 | tk::ScrollByUnits %W h [expr {-10 * (%D)}] | |
146 | } | |
147 | } | |
148 | # tk::ScrollButtonDown -- | |
149 | # This procedure is invoked when a button is pressed in a scrollbar. | |
150 | # It changes the way the scrollbar is displayed and takes actions | |
151 | # depending on where the mouse is. | |
152 | # | |
153 | # Arguments: | |
154 | # w - The scrollbar widget. | |
155 | # x, y - Mouse coordinates. | |
156 | ||
157 | proc tk::ScrollButtonDown {w x y} { | |
158 | variable ::tk::Priv | |
159 | set Priv(relief) [$w cget -activerelief] | |
160 | $w configure -activerelief sunken | |
161 | set element [$w identify $x $y] | |
162 | if {[string equal $element "slider"]} { | |
163 | ScrollStartDrag $w $x $y | |
164 | } else { | |
165 | ScrollSelect $w $element initial | |
166 | } | |
167 | } | |
168 | ||
169 | # ::tk::ScrollButtonUp -- | |
170 | # This procedure is invoked when a button is released in a scrollbar. | |
171 | # It cancels scans and auto-repeats that were in progress, and restores | |
172 | # the way the active element is displayed. | |
173 | # | |
174 | # Arguments: | |
175 | # w - The scrollbar widget. | |
176 | # x, y - Mouse coordinates. | |
177 | ||
178 | proc ::tk::ScrollButtonUp {w x y} { | |
179 | variable ::tk::Priv | |
180 | tk::CancelRepeat | |
181 | if {[info exists Priv(relief)]} { | |
182 | # Avoid error due to spurious release events | |
183 | $w configure -activerelief $Priv(relief) | |
184 | ScrollEndDrag $w $x $y | |
185 | $w activate [$w identify $x $y] | |
186 | } | |
187 | } | |
188 | ||
189 | # ::tk::ScrollSelect -- | |
190 | # This procedure is invoked when a button is pressed over the scrollbar. | |
191 | # It invokes one of several scrolling actions depending on where in | |
192 | # the scrollbar the button was pressed. | |
193 | # | |
194 | # Arguments: | |
195 | # w - The scrollbar widget. | |
196 | # element - The element of the scrollbar that was selected, such | |
197 | # as "arrow1" or "trough2". Shouldn't be "slider". | |
198 | # repeat - Whether and how to auto-repeat the action: "noRepeat" | |
199 | # means don't auto-repeat, "initial" means this is the | |
200 | # first action in an auto-repeat sequence, and "again" | |
201 | # means this is the second repetition or later. | |
202 | ||
203 | proc ::tk::ScrollSelect {w element repeat} { | |
204 | variable ::tk::Priv | |
205 | if {![winfo exists $w]} return | |
206 | switch -- $element { | |
207 | "arrow1" {ScrollByUnits $w hv -1} | |
208 | "trough1" {ScrollByPages $w hv -1} | |
209 | "trough2" {ScrollByPages $w hv 1} | |
210 | "arrow2" {ScrollByUnits $w hv 1} | |
211 | default {return} | |
212 | } | |
213 | if {[string equal $repeat "again"]} { | |
214 | set Priv(afterId) [after [$w cget -repeatinterval] \ | |
215 | [list tk::ScrollSelect $w $element again]] | |
216 | } elseif {[string equal $repeat "initial"]} { | |
217 | set delay [$w cget -repeatdelay] | |
218 | if {$delay > 0} { | |
219 | set Priv(afterId) [after $delay \ | |
220 | [list tk::ScrollSelect $w $element again]] | |
221 | } | |
222 | } | |
223 | } | |
224 | ||
225 | # ::tk::ScrollStartDrag -- | |
226 | # This procedure is called to initiate a drag of the slider. It just | |
227 | # remembers the starting position of the mouse and slider. | |
228 | # | |
229 | # Arguments: | |
230 | # w - The scrollbar widget. | |
231 | # x, y - The mouse position at the start of the drag operation. | |
232 | ||
233 | proc ::tk::ScrollStartDrag {w x y} { | |
234 | variable ::tk::Priv | |
235 | ||
236 | if {[string equal [$w cget -command] ""]} { | |
237 | return | |
238 | } | |
239 | set Priv(pressX) $x | |
240 | set Priv(pressY) $y | |
241 | set Priv(initValues) [$w get] | |
242 | set iv0 [lindex $Priv(initValues) 0] | |
243 | if {[llength $Priv(initValues)] == 2} { | |
244 | set Priv(initPos) $iv0 | |
245 | } elseif {$iv0 == 0} { | |
246 | set Priv(initPos) 0.0 | |
247 | } else { | |
248 | set Priv(initPos) [expr {(double([lindex $Priv(initValues) 2])) \ | |
249 | / [lindex $Priv(initValues) 0]}] | |
250 | } | |
251 | } | |
252 | ||
253 | # ::tk::ScrollDrag -- | |
254 | # This procedure is called for each mouse motion even when the slider | |
255 | # is being dragged. It notifies the associated widget if we're not | |
256 | # jump scrolling, and it just updates the scrollbar if we are jump | |
257 | # scrolling. | |
258 | # | |
259 | # Arguments: | |
260 | # w - The scrollbar widget. | |
261 | # x, y - The current mouse position. | |
262 | ||
263 | proc ::tk::ScrollDrag {w x y} { | |
264 | variable ::tk::Priv | |
265 | ||
266 | if {[string equal $Priv(initPos) ""]} { | |
267 | return | |
268 | } | |
269 | set delta [$w delta [expr {$x - $Priv(pressX)}] [expr {$y - $Priv(pressY)}]] | |
270 | if {[$w cget -jump]} { | |
271 | if {[llength $Priv(initValues)] == 2} { | |
272 | $w set [expr {[lindex $Priv(initValues) 0] + $delta}] \ | |
273 | [expr {[lindex $Priv(initValues) 1] + $delta}] | |
274 | } else { | |
275 | set delta [expr {round($delta * [lindex $Priv(initValues) 0])}] | |
276 | eval [list $w] set [lreplace $Priv(initValues) 2 3 \ | |
277 | [expr {[lindex $Priv(initValues) 2] + $delta}] \ | |
278 | [expr {[lindex $Priv(initValues) 3] + $delta}]] | |
279 | } | |
280 | } else { | |
281 | ScrollToPos $w [expr {$Priv(initPos) + $delta}] | |
282 | } | |
283 | } | |
284 | ||
285 | # ::tk::ScrollEndDrag -- | |
286 | # This procedure is called to end an interactive drag of the slider. | |
287 | # It scrolls the window if we're in jump mode, otherwise it does nothing. | |
288 | # | |
289 | # Arguments: | |
290 | # w - The scrollbar widget. | |
291 | # x, y - The mouse position at the end of the drag operation. | |
292 | ||
293 | proc ::tk::ScrollEndDrag {w x y} { | |
294 | variable ::tk::Priv | |
295 | ||
296 | if {[string equal $Priv(initPos) ""]} { | |
297 | return | |
298 | } | |
299 | if {[$w cget -jump]} { | |
300 | set delta [$w delta [expr {$x - $Priv(pressX)}] \ | |
301 | [expr {$y - $Priv(pressY)}]] | |
302 | ScrollToPos $w [expr {$Priv(initPos) + $delta}] | |
303 | } | |
304 | set Priv(initPos) "" | |
305 | } | |
306 | ||
307 | # ::tk::ScrollByUnits -- | |
308 | # This procedure tells the scrollbar's associated widget to scroll up | |
309 | # or down by a given number of units. It notifies the associated widget | |
310 | # in different ways for old and new command syntaxes. | |
311 | # | |
312 | # Arguments: | |
313 | # w - The scrollbar widget. | |
314 | # orient - Which kinds of scrollbars this applies to: "h" for | |
315 | # horizontal, "v" for vertical, "hv" for both. | |
316 | # amount - How many units to scroll: typically 1 or -1. | |
317 | ||
318 | proc ::tk::ScrollByUnits {w orient amount} { | |
319 | set cmd [$w cget -command] | |
320 | if {[string equal $cmd ""] || ([string first \ | |
321 | [string index [$w cget -orient] 0] $orient] < 0)} { | |
322 | return | |
323 | } | |
324 | set info [$w get] | |
325 | if {[llength $info] == 2} { | |
326 | uplevel #0 $cmd scroll $amount units | |
327 | } else { | |
328 | uplevel #0 $cmd [expr {[lindex $info 2] + $amount}] | |
329 | } | |
330 | } | |
331 | ||
332 | # ::tk::ScrollByPages -- | |
333 | # This procedure tells the scrollbar's associated widget to scroll up | |
334 | # or down by a given number of screenfuls. It notifies the associated | |
335 | # widget in different ways for old and new command syntaxes. | |
336 | # | |
337 | # Arguments: | |
338 | # w - The scrollbar widget. | |
339 | # orient - Which kinds of scrollbars this applies to: "h" for | |
340 | # horizontal, "v" for vertical, "hv" for both. | |
341 | # amount - How many screens to scroll: typically 1 or -1. | |
342 | ||
343 | proc ::tk::ScrollByPages {w orient amount} { | |
344 | set cmd [$w cget -command] | |
345 | if {[string equal $cmd ""] || ([string first \ | |
346 | [string index [$w cget -orient] 0] $orient] < 0)} { | |
347 | return | |
348 | } | |
349 | set info [$w get] | |
350 | if {[llength $info] == 2} { | |
351 | uplevel #0 $cmd scroll $amount pages | |
352 | } else { | |
353 | uplevel #0 $cmd [expr {[lindex $info 2] + $amount*([lindex $info 1] - 1)}] | |
354 | } | |
355 | } | |
356 | ||
357 | # ::tk::ScrollToPos -- | |
358 | # This procedure tells the scrollbar's associated widget to scroll to | |
359 | # a particular location, given by a fraction between 0 and 1. It notifies | |
360 | # the associated widget in different ways for old and new command syntaxes. | |
361 | # | |
362 | # Arguments: | |
363 | # w - The scrollbar widget. | |
364 | # pos - A fraction between 0 and 1 indicating a desired position | |
365 | # in the document. | |
366 | ||
367 | proc ::tk::ScrollToPos {w pos} { | |
368 | set cmd [$w cget -command] | |
369 | if {[string equal $cmd ""]} { | |
370 | return | |
371 | } | |
372 | set info [$w get] | |
373 | if {[llength $info] == 2} { | |
374 | uplevel #0 $cmd moveto $pos | |
375 | } else { | |
376 | uplevel #0 $cmd [expr {round([lindex $info 0]*$pos)}] | |
377 | } | |
378 | } | |
379 | ||
380 | # ::tk::ScrollTopBottom | |
381 | # Scroll to the top or bottom of the document, depending on the mouse | |
382 | # position. | |
383 | # | |
384 | # Arguments: | |
385 | # w - The scrollbar widget. | |
386 | # x, y - Mouse coordinates within the widget. | |
387 | ||
388 | proc ::tk::ScrollTopBottom {w x y} { | |
389 | variable ::tk::Priv | |
390 | set element [$w identify $x $y] | |
391 | if {[string match *1 $element]} { | |
392 | ScrollToPos $w 0 | |
393 | } elseif {[string match *2 $element]} { | |
394 | ScrollToPos $w 1 | |
395 | } | |
396 | ||
397 | # Set Priv(relief), since it's needed by tk::ScrollButtonUp. | |
398 | ||
399 | set Priv(relief) [$w cget -activerelief] | |
400 | } | |
401 | ||
402 | # ::tk::ScrollButton2Down | |
403 | # This procedure is invoked when button 2 is pressed over a scrollbar. | |
404 | # If the button is over the trough or slider, it sets the scrollbar to | |
405 | # the mouse position and starts a slider drag. Otherwise it just | |
406 | # behaves the same as button 1. | |
407 | # | |
408 | # Arguments: | |
409 | # w - The scrollbar widget. | |
410 | # x, y - Mouse coordinates within the widget. | |
411 | ||
412 | proc ::tk::ScrollButton2Down {w x y} { | |
413 | variable ::tk::Priv | |
414 | set element [$w identify $x $y] | |
415 | if {[string match {arrow[12]} $element]} { | |
416 | ScrollButtonDown $w $x $y | |
417 | return | |
418 | } | |
419 | ScrollToPos $w [$w fraction $x $y] | |
420 | set Priv(relief) [$w cget -activerelief] | |
421 | ||
422 | # Need the "update idletasks" below so that the widget calls us | |
423 | # back to reset the actual scrollbar position before we start the | |
424 | # slider drag. | |
425 | ||
426 | update idletasks | |
427 | $w configure -activerelief sunken | |
428 | $w activate slider | |
429 | ScrollStartDrag $w $x $y | |
430 | } |