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