scrollbar.tcl
1 # 2 # Bindings for TScrollbar widget 3 # 4 5 namespace eval ttk::scrollbar { 6 variable State 7 # State(xPress) -- 8 # State(yPress) -- initial position of mouse at start of drag. 9 # State(first) -- value of -first at start of drag. 10 } 11 12 bind TScrollbar <Button-1> { ttk::scrollbar::Press %W %x %y } 13 bind TScrollbar <B1-Motion> { ttk::scrollbar::Drag %W %x %y } 14 bind TScrollbar <ButtonRelease-1> { ttk::scrollbar::Release %W %x %y } 15 16 bind TScrollbar <Button-2> { ttk::scrollbar::Jump %W %x %y } 17 bind TScrollbar <B2-Motion> { ttk::scrollbar::Drag %W %x %y } 18 bind TScrollbar <ButtonRelease-2> { ttk::scrollbar::Release %W %x %y } 19 20 # Redirect scrollwheel bindings to the scrollbar widget 21 # 22 # The shift-bindings scroll left/right (not up/down) 23 # if a widget has both possibilities 24 set eventList [list <MouseWheel> <Shift-MouseWheel>] 25 switch [tk windowingsystem] { 26 aqua { 27 lappend eventList <Option-MouseWheel> <Shift-Option-MouseWheel> 28 } 29 x11 { 30 lappend eventList <Button-4> <Button-5> \ 31 <Shift-Button-4> <Shift-Button-5> 32 } 33 } 34 foreach event $eventList { 35 bind TScrollbar $event [bind Scrollbar $event] 36 } 37 unset eventList event 38 39 proc ttk::scrollbar::Scroll {w n units} { 40 set cmd [$w cget -command] 41 if {$cmd ne ""} { 42 uplevel #0 $cmd scroll $n $units 43 } 44 } 45 46 proc ttk::scrollbar::Moveto {w fraction} { 47 set cmd [$w cget -command] 48 if {$cmd ne ""} { 49 uplevel #0 $cmd moveto $fraction 50 } 51 } 52 53 proc ttk::scrollbar::Press {w x y} { 54 variable State 55 56 set State(xPress) $x 57 set State(yPress) $y 58 59 switch -glob -- [$w identify $x $y] { 60 *uparrow - 61 *leftarrow { 62 ttk::Repeatedly Scroll $w -1 units 63 } 64 *downarrow - 65 *rightarrow { 66 ttk::Repeatedly Scroll $w 1 units 67 } 68 *grip - 69 *thumb { 70 set State(first) [lindex [$w get] 0] 71 } 72 *trough { 73 set f [$w fraction $x $y] 74 if {$f < [lindex [$w get] 0]} { 75 # Clicked in upper/left trough 76 ttk::Repeatedly Scroll $w -1 pages 77 } elseif {$f > [lindex [$w get] 1]} { 78 # Clicked in lower/right trough 79 ttk::Repeatedly Scroll $w 1 pages 80 } else { 81 # Clicked on thumb (???) 82 set State(first) [lindex [$w get] 0] 83 } 84 } 85 } 86 } 87 88 proc ttk::scrollbar::Drag {w x y} { 89 variable State 90 if {![info exists State(first)]} { 91 # Initial buttonpress was not on the thumb, 92 # or something screwy has happened. In either case, ignore: 93 return; 94 } 95 set xDelta [expr {$x - $State(xPress)}] 96 set yDelta [expr {$y - $State(yPress)}] 97 Moveto $w [expr {$State(first) + [$w delta $xDelta $yDelta]}] 98 } 99 100 proc ttk::scrollbar::Release {w x y} { 101 variable State 102 unset -nocomplain State(xPress) State(yPress) State(first) 103 ttk::CancelRepeat 104 } 105 106 # scrollbar::Jump -- Button-2 binding for scrollbars. 107 # Behaves exactly like scrollbar::Press, except that 108 # clicking in the trough jumps to the the selected position. 109 # 110 proc ttk::scrollbar::Jump {w x y} { 111 variable State 112 113 switch -glob -- [$w identify $x $y] { 114 *grip - 115 *thumb - 116 *trough { 117 set State(first) [$w fraction $x $y] 118 Moveto $w $State(first) 119 set State(xPress) $x 120 set State(yPress) $y 121 } 122 default { 123 Press $w $x $y 124 } 125 } 126 }