library/scrollbar.tcl

   1 # scrollbar.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 # Copyright (c) 1994 The Regents of the University of California.
   7 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
   8 #
   9 # See the file "license.terms" for information on usage and redistribution
  10 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11 #
  12
  13 #-------------------------------------------------------------------------
  14 # The code below creates the default class bindings for scrollbars.
  15 #-------------------------------------------------------------------------
  16
  17 bind Scrollbar <Up> {
  18     ckScrollByUnits %W v -1
  19 }
  20 bind Scrollbar <Down> {
  21     ckScrollByUnits %W v 1
  22 }
  23 bind Scrollbar <Left> {
  24     ckScrollByUnits %W h -1
  25 }
  26 bind Scrollbar <Right> {
  27     ckScrollByUnits %W h 1
  28 }
  29 bind Scrollbar <Prior> {
  30     ckScrollByPages %W hv -1
  31 }
  32 bind Scrollbar <Next> {
  33     ckScrollByPages %W hv 1
  34 }
  35 bind Scrollbar <Home> {
  36     ckScrollToPos %W 0
  37 }
  38 bind Scrollbar <End> {
  39     ckScrollToPos %W 1
  40 }
  41 bind Scrollbar <Button-1> {
  42     ckScrollByButton %W %x %y
  43 }
  44
  45 bind Scrollbar <FocusIn> {%W activate}
  46 bind Scrollbar <FocusOut> {%W deactivate}
  47
  48 # ckScrollByUnits --
  49 # This procedure tells the scrollbar's associated widget to scroll up
  50 # or down by a given number of units.  It notifies the associated widget
  51 # in different ways for old and new command syntaxes.
  52 #
  53 # Arguments:
  54 # w -           The scrollbar widget.
  55 # orient -      Which kinds of scrollbars this applies to:  "h" for
  56 #               horizontal, "v" for vertical, "hv" for both.
  57 # amount -      How many units to scroll:  typically 1 or -1.
  58
  59 proc ckScrollByUnits {w orient amount} {
  60     set cmd [$w cget -command]
  61     if {($cmd == "") || ([string first \
  62             [string index [$w cget -orient] 0] $orient] < 0)} {
  63         return
  64     }
  65     set info [$w get]
  66     if {[llength $info] == 2} {
  67         uplevel #0 $cmd scroll $amount units
  68     } else {
  69         uplevel #0 $cmd [expr [lindex $info 2] + $amount]
  70     }
  71 }
  72
  73 # ckScrollByPages --
  74 # This procedure tells the scrollbar's associated widget to scroll up
  75 # or down by a given number of screenfuls.  It notifies the associated
  76 # widget in different ways for old and new command syntaxes.
  77 #
  78 # Arguments:
  79 # w -           The scrollbar widget.
  80 # orient -      Which kinds of scrollbars this applies to:  "h" for
  81 #               horizontal, "v" for vertical, "hv" for both.
  82 # amount -      How many screens to scroll:  typically 1 or -1.
  83
  84 proc ckScrollByPages {w orient amount} {
  85     set cmd [$w cget -command]
  86     if {($cmd == "") || ([string first \
  87             [string index [$w cget -orient] 0] $orient] < 0)} {
  88         return
  89     }
  90     set info [$w get]
  91     if {[llength $info] == 2} {
  92         uplevel #0 $cmd scroll $amount pages
  93     } else {
  94         uplevel #0 $cmd [expr [lindex $info 2] + $amount*([lindex $info 1] - 1)]
  95     }
  96 }
  97
  98 # ckScrollToPos --
  99 # This procedure tells the scrollbar's associated widget to scroll to
 100 # a particular location, given by a fraction between 0 and 1.  It notifies
 101 # the associated widget in different ways for old and new command syntaxes.
 102 #
 103 # Arguments:
 104 # w -           The scrollbar widget.
 105 # pos -         A fraction between 0 and 1 indicating a desired position
 106 #               in the document.
 107
 108 proc ckScrollToPos {w pos} {
 109     set cmd [$w cget -command]
 110     if {($cmd == "")} {
 111         return
 112     }
 113     set info [$w get]
 114     if {[llength $info] == 2} {
 115         uplevel #0 $cmd moveto $pos
 116     } else {
 117         uplevel #0 $cmd [expr round([lindex $info 0]*$pos)]
 118     }
 119 }
 120
 121 # ckScrollByButton --
 122 # This procedure is invoked for button presses on any element of the
 123 # scrollbar.
 124 #
 125 # Arguments:
 126 # w -           The scrollbar widget.
 127 # x, y -        Mouse coordinates of button press.
 128
 129 proc ckScrollByButton {w x y} {
 130     set element [$w identify $x $y]
 131     if {$element == "arrow1"} {
 132         ckScrollByUnits $w hv -1
 133     } elseif {$element == "trough1"} {
 134         ckScrollByPages $w hv -1
 135     } elseif {$element == "trough2"} {
 136         ckScrollByPages $w hv 1
 137     } elseif {$element == "arrow2"} {
 138         ckScrollByUnits $w hv 1
 139     } else {
 140         return
 141     }
 142 }
 143