mingw/lib/tk8.5/ttk/scrollbar.tcl

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