1# spinbox.tcl -- 2# 3# BWidget SpinBox implementation. 4# 5# Copyright (c) 1999 by Unifix 6# Copyright (c) 2000 by Ajuba Solutions 7# All rights reserved. 8# 9# RCS: @(#) $Id: spinbox.tcl,v 1.14 2009/10/25 20:55:36 oberdorfer Exp $ 10# ----------------------------------------------------------------------------- 11# Index of commands: 12# - SpinBox::create 13# - SpinBox::configure 14# - SpinBox::cget 15# - SpinBox::setvalue 16# - SpinBox::_destroy 17# - SpinBox::_modify_value 18# - SpinBox::_test_options 19# ----------------------------------------------------------------------------- 20 21namespace eval SpinBox { 22 Widget::define SpinBox spinbox Entry ArrowButton 23 24 Widget::tkinclude SpinBox frame :cmd \ 25 include {-background -borderwidth -bg -bd -relief} \ 26 initialize {-relief sunken -borderwidth 2} 27 28 Widget::bwinclude SpinBox Entry .e \ 29 remove {-relief -bd -borderwidth -fg -bg} \ 30 rename {-foreground -entryfg -background -entrybg} 31 32 Widget::declare SpinBox { 33 {-range String "" 0} 34 {-values String "" 0} 35 {-modifycmd String "" 0} 36 {-repeatdelay Int 400 0 {%d >= 0}} 37 {-repeatinterval Int 100 0 {%d >= 0}} 38 {-foreground Color "SystemWindowText" 0} 39 } 40 41 Widget::addmap SpinBox "" :cmd {-background {}} 42 Widget::addmap SpinBox ArrowButton .arrup { 43 -foreground {} -background {} -disabledforeground {} -state {} \ 44 -repeatinterval {} -repeatdelay {} 45 } 46 Widget::addmap SpinBox ArrowButton .arrdn { 47 -foreground {} -background {} -disabledforeground {} -state {} \ 48 -repeatinterval {} -repeatdelay {} 49 } 50 51 ::bind SpinBox <FocusIn> [list after idle {BWidget::refocus %W %W.e}] 52 ::bind SpinBox <Destroy> [list SpinBox::_destroy %W] 53 54 variable _widget 55} 56 57 58# ----------------------------------------------------------------------------- 59# Command SpinBox::create 60# ----------------------------------------------------------------------------- 61proc SpinBox::create { path args } { 62 array set maps [list SpinBox {} :cmd {} .e {} .arrup {} .arrdn {}] 63 array set maps [Widget::parseArgs SpinBox $args] 64 eval [list frame $path] $maps(:cmd) \ 65 [list -highlightthickness 0 -takefocus 0 -class SpinBox] 66 Widget::initFromODB SpinBox $path $maps(SpinBox) 67 68 set entry [eval [list Entry::create $path.e] $maps(.e) -relief flat -bd 0] 69 bindtags $path.e [linsert [bindtags $path.e] 1 SpinBoxEntry] 70 71 if { [BWidget::using ttk] } { 72 set farr [ttk::frame $path.farr -relief flat] 73 } else { 74 set farr [frame $path.farr -relief flat -bd 0 -highlightthickness 0] 75 } 76 77 set height [expr {[winfo reqheight $path.e]/2-2}] 78 set width 11 79 set arrup [eval [list ArrowButton::create $path.arrup -dir top] \ 80 $maps(.arrup) \ 81 [list -highlightthickness 0 -borderwidth 1 -takefocus 0 \ 82 -type button -width $width -height $height \ 83 -armcommand [list SpinBox::_modify_value $path next arm] \ 84 -disarmcommand [list SpinBox::_modify_value $path next disarm]]] 85 set arrdn [eval [list ArrowButton::create $path.arrdn -dir bottom] \ 86 $maps(.arrdn) \ 87 [list -highlightthickness 0 -borderwidth 1 -takefocus 0 \ 88 -type button -width $width -height $height \ 89 -armcommand [list SpinBox::_modify_value $path previous arm] \ 90 -disarmcommand [list SpinBox::_modify_value $path previous disarm]]] 91 92 # --- update SpinBox value --- 93 _test_options $path 94 set val [Entry::cget $path.e -text] 95 if { [string equal $val ""] } { 96 Entry::configure $path.e -text $::SpinBox::_widget($path,curval) 97 } else { 98 set ::SpinBox::_widget($path,curval) $val 99 } 100 101 grid $arrup -in $farr -column 0 -row 0 -sticky nsew 102 grid $arrdn -in $farr -column 0 -row 2 -sticky nsew 103 grid rowconfigure $farr 0 -weight 1 104 grid rowconfigure $farr 2 -weight 1 105 106 pack $farr -side right -fill y 107 pack $entry -side left -fill both -expand yes 108 109 ::bind $entry <Key-Up> [list SpinBox::_modify_value $path next activate] 110 ::bind $entry <Key-Down> [list SpinBox::_modify_value $path previous activate] 111 ::bind $entry <Key-Prior> [list SpinBox::_modify_value $path last activate] 112 ::bind $entry <Key-Next> [list SpinBox::_modify_value $path first activate] 113 114 ::bind $farr <Configure> {grid rowconfigure %W 1 -minsize [expr {%h%%2}]} 115 116 return [Widget::create SpinBox $path] 117} 118 119# ----------------------------------------------------------------------------- 120# Command SpinBox::configure 121# ----------------------------------------------------------------------------- 122proc SpinBox::configure { path args } { 123 set res [Widget::configure $path $args] 124 if { [Widget::hasChangedX $path -values] || 125 [Widget::hasChangedX $path -range] } { 126 _test_options $path 127 } 128 return $res 129} 130 131 132# ----------------------------------------------------------------------------- 133# Command SpinBox::cget 134# ----------------------------------------------------------------------------- 135proc SpinBox::cget { path option } { 136 return [Widget::cget $path $option] 137} 138 139 140# ----------------------------------------------------------------------------- 141# Command SpinBox::setvalue 142# ----------------------------------------------------------------------------- 143proc SpinBox::setvalue { path index } { 144 variable _widget 145 146 set values [Widget::getMegawidgetOption $path -values] 147 set value [Entry::cget $path.e -text] 148 149 if { [llength $values] } { 150 # --- -values SpinBox --- 151 switch -- $index { 152 next { 153 if { [set idx [lsearch $values $value]] != -1 } { 154 incr idx 155 } elseif { [set idx [lsearch $values "$value*"]] == -1 } { 156 set idx [lsearch $values $_widget($path,curval)] 157 } 158 } 159 previous { 160 if { [set idx [lsearch $values $value]] != -1 } { 161 incr idx -1 162 } elseif { [set idx [lsearch $values "$value*"]] == -1 } { 163 set idx [lsearch $values $_widget($path,curval)] 164 } 165 } 166 first { 167 set idx 0 168 } 169 last { 170 set idx [expr {[llength $values]-1}] 171 } 172 default { 173 if { [string index $index 0] == "@" } { 174 set idx [string range $index 1 end] 175 if { [catch {string compare [expr {int($idx)}] $idx} res] || $res != 0 } { 176 return -code error "bad index \"$index\"" 177 } 178 } else { 179 return -code error "bad index \"$index\"" 180 } 181 } 182 } 183 if { $idx >= 0 && $idx < [llength $values] } { 184 set newval [lindex $values $idx] 185 } else { 186 return 0 187 } 188 } else { 189 # --- -range SpinBox --- 190 foreach {vmin vmax incr} [Widget::getMegawidgetOption $path -range] { 191 break 192 } 193 # Allow zero padding on the value; strip it out for calculation by 194 # scanning the value into a floating point number. 195 scan $value %f value 196 switch -- $index { 197 next { 198 if { [catch {expr {double($value-$vmin)/$incr}} idx] } { 199 set newval $_widget($path,curval) 200 } else { 201 set newval [expr {$vmin+(round($idx)+1)*$incr}] 202 if { $newval < $vmin } { 203 set newval $vmin 204 } elseif { $newval > $vmax } { 205 set newval $vmax 206 } 207 } 208 } 209 previous { 210 if { [catch {expr {double($value-$vmin)/$incr}} idx] } { 211 set newval $_widget($path,curval) 212 } else { 213 set newval [expr {$vmin+(round($idx)-1)*$incr}] 214 if { $newval < $vmin } { 215 set newval $vmin 216 } elseif { $newval > $vmax } { 217 set newval $vmax 218 } 219 } 220 } 221 first { 222 set newval $vmin 223 } 224 last { 225 set newval $vmax 226 } 227 default { 228 if { [string index $index 0] == "@" } { 229 set idx [string range $index 1 end] 230 if { [catch {string compare [expr {int($idx)}] $idx} res] || $res != 0 } { 231 return -code error "bad index \"$index\"" 232 } 233 set newval [expr {$vmin+int($idx)*$incr}] 234 if { $newval < $vmin || $newval > $vmax } { 235 return 0 236 } 237 } else { 238 return -code error "bad index \"$index\"" 239 } 240 } 241 } 242 } 243 set _widget($path,curval) $newval 244 Entry::configure $path.e -text $newval 245 return 1 246} 247 248 249# ----------------------------------------------------------------------------- 250# Command SpinBox::getvalue 251# ----------------------------------------------------------------------------- 252proc SpinBox::getvalue { path } { 253 variable _widget 254 255 set values [Widget::getMegawidgetOption $path -values] 256 set value [Entry::cget $path.e -text] 257 258 if { [llength $values] } { 259 # --- -values SpinBox --- 260 return [lsearch $values $value] 261 } else { 262 foreach {vmin vmax incr} [Widget::getMegawidgetOption $path -range] { 263 break 264 } 265 if { ![catch {expr {double($value-$vmin)/$incr}} idx] && 266 $idx == int($idx) } { 267 return [expr {int($idx)}] 268 } 269 return -1 270 } 271} 272 273 274# ----------------------------------------------------------------------------- 275# Command SpinBox::bind 276# ----------------------------------------------------------------------------- 277proc SpinBox::bind { path args } { 278 return [eval [list ::bind $path.e] $args] 279} 280 281 282# ----------------------------------------------------------------------------- 283# Command SpinBox::_modify_value 284# ----------------------------------------------------------------------------- 285proc SpinBox::_modify_value { path direction reason } { 286 if { $reason == "arm" || $reason == "activate" } { 287 SpinBox::setvalue $path $direction 288 } 289 if { ($reason == "disarm" || $reason == "activate") && 290 [set cmd [Widget::getMegawidgetOption $path -modifycmd]] != "" } { 291 uplevel \#0 $cmd 292 } 293} 294 295# ----------------------------------------------------------------------------- 296# Command SpinBox::_test_options 297# ----------------------------------------------------------------------------- 298proc SpinBox::_test_options { path } { 299 set values [Widget::getMegawidgetOption $path -values] 300 if { [llength $values] } { 301 set ::SpinBox::_widget($path,curval) [lindex $values 0] 302 } else { 303 foreach {vmin vmax incr} [Widget::getMegawidgetOption $path -range] { 304 break 305 } 306 set update 0 307 if { [catch {expr {int($vmin)}}] } { 308 set vmin 0 309 set update 1 310 } 311 if { [catch {expr {$vmax<$vmin}} res] || $res } { 312 set vmax $vmin 313 set update 1 314 } 315 if { [catch {expr {$incr<0}} res] || $res } { 316 set incr 1 317 set update 1 318 } 319 # Only do the set back (which is expensive) if we changed a value 320 if { $update } { 321 Widget::setMegawidgetOption $path -range [list $vmin $vmax $incr] 322 } 323 set ::SpinBox::_widget($path,curval) $vmin 324 } 325} 326 327 328# ----------------------------------------------------------------------------- 329# Command SpinBox::_destroy 330# ----------------------------------------------------------------------------- 331proc SpinBox::_destroy { path } { 332 variable _widget 333 334 unset _widget($path,curval) 335 Widget::destroy $path 336} 337