/ lib / tcltk / tk8.6 / ttk / scrollbar.tcl
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  }