source: trunk/BWidget-1.2.1/spinbox.tcl @ 931

Last change on this file since 931 was 931, checked in by toby, 11 years ago

include rest of files

File size: 12.3 KB
Line 
1# ------------------------------------------------------------------------------
2#  spinbox.tcl
3#  This file is part of Unifix BWidget Toolkit
4# ------------------------------------------------------------------------------
5#  Index of commands:
6#     - SpinBox::create
7#     - SpinBox::configure
8#     - SpinBox::cget
9#     - SpinBox::setvalue
10#     - SpinBox::_destroy
11#     - SpinBox::_modify_value
12#     - SpinBox::_test_options
13# ------------------------------------------------------------------------------
14
15namespace eval SpinBox {
16    ArrowButton::use
17    Entry::use
18    LabelFrame::use
19
20    Widget::bwinclude SpinBox LabelFrame .labf \
21        rename     {-text -label} \
22        prefix     {label -justify -width -anchor -height -font} \
23        remove     {-focus} \
24        initialize {-relief sunken -borderwidth 2}
25
26    Widget::bwinclude SpinBox Entry .e \
27        remove {-relief -bd -borderwidth -fg -bg} \
28        rename {-foreground -entryfg -background -entrybg}
29
30    Widget::declare SpinBox {
31        {-range          String ""  0}
32        {-values         String ""  0}
33        {-modifycmd      String ""  0}
34        {-repeatdelay    Int    400 0 {=0}}
35        {-repeatinterval Int    100 0 {=0}}
36    }
37
38    Widget::addmap SpinBox "" :cmd {-background {}}
39    Widget::addmap SpinBox ArrowButton .arrup {
40        -foreground {} -background {} -disabledforeground {} -state {}
41        -repeatdelay {} -repeatinterval {}
42    }
43    Widget::addmap SpinBox ArrowButton .arrdn {
44        -foreground {} -background {} -disabledforeground {} -state {}
45        -repeatdelay {} -repeatinterval {}
46    }
47
48    Widget::syncoptions SpinBox Entry .e {-text {}}
49    Widget::syncoptions SpinBox LabelFrame .labf {-label -text -underline {}}
50
51    ::bind BwSpinBox <FocusIn> {focus %W.labf}
52    ::bind BwSpinBox <Destroy> {SpinBox::_destroy %W}
53
54    proc ::SpinBox { path args } { return [eval SpinBox::create $path $args] }
55    proc use {} {}
56
57    variable _widget
58}
59
60
61# ------------------------------------------------------------------------------
62#  Command SpinBox::create
63# ------------------------------------------------------------------------------
64proc SpinBox::create { path args } {
65    variable _widget
66
67    Widget::init SpinBox $path $args
68
69    _test_options $path
70    eval frame $path [Widget::subcget $path :cmd] \
71        -highlightthickness 0 -bd 0 -relief flat -takefocus 0
72    set labf [eval LabelFrame::create $path.labf [Widget::subcget $path .labf] \
73                  -borderwidth 2 -relief sunken -focus $path.e]
74    set entry [eval Entry::create $path.e [Widget::subcget $path .e] \
75                   -relief flat -borderwidth 0]
76
77    bindtags $path [list $path BwSpinBox [winfo toplevel $path] all]
78
79    set farr   [frame $path.farr -relief flat -bd 0 -highlightthickness 0]
80    set height [expr {[winfo reqheight $path.e]/2-2}]
81    set width  11
82    set arrup  [eval ArrowButton::create $path.arrup -dir top \
83                    [Widget::subcget $path .arrup] \
84                    -highlightthickness 0 -borderwidth 1 -takefocus 0 \
85                    -type button \
86                    -width $width -height $height \
87                    -armcommand    [list "SpinBox::_modify_value $path next arm"] \
88                    -disarmcommand [list "SpinBox::_modify_value $path next disarm"]]
89    set arrdn  [eval ArrowButton::create $path.arrdn -dir bottom \
90                    [Widget::subcget $path .arrdn] \
91                    -highlightthickness 0 -borderwidth 1 -takefocus 0 \
92                    -type button \
93                    -width $width -height $height \
94                    -armcommand    [list "SpinBox::_modify_value $path previous arm"] \
95                    -disarmcommand [list "SpinBox::_modify_value $path previous disarm"]]
96    set frame [LabelFrame::getframe $path.labf]
97
98    # --- update -value ---
99    if { [set val [Entry::cget $path.e -text]] != "" } {
100        set _widget($path,curval) $val
101    } else {
102        if { [set var [Widget::getoption $path -textvariable]] != "" } {
103            GlobalVar::setvar $var $_widget($path,curval)
104        } else {
105            Entry::configure $path.e -text $_widget($path,curval)
106        }
107    }
108    Widget::setoption $path -text $_widget($path,curval)
109
110    grid $arrup -in $farr -column 0 -row 0 -sticky nsew
111    grid $arrdn -in $farr -column 0 -row 2 -sticky nsew
112    grid rowconfigure $farr 0 -weight 1
113    grid rowconfigure $farr 2 -weight 1
114
115    pack $farr  -in $frame -side right -fill y
116    pack $entry -in $frame -side left  -fill both -expand yes
117    pack $labf  -fill both -expand yes
118
119    ::bind $entry <Key-Up>    "SpinBox::_modify_value $path next activate"
120    ::bind $entry <Key-Down>  "SpinBox::_modify_value $path previous activate"
121    ::bind $entry <Key-Prior> "SpinBox::_modify_value $path last activate"
122    ::bind $entry <Key-Next>  "SpinBox::_modify_value $path first activate"
123
124    ::bind $farr <Configure> {grid rowconfigure %W 1 -minsize [expr {%h%%2}]}
125
126    rename $path ::$path:cmd
127    proc ::$path { cmd args } "return \[eval SpinBox::\$cmd $path \$args\]"
128
129    return $path
130}
131
132
133# ------------------------------------------------------------------------------
134#  Command SpinBox::configure
135# ------------------------------------------------------------------------------
136proc SpinBox::configure { path args } {
137    set res [Widget::configure $path $args]
138    if { [Widget::hasChanged $path -values val] ||
139         [Widget::hasChanged $path -range  val] } {
140        _test_options $path
141    }
142    return $res
143}
144
145
146# ------------------------------------------------------------------------------
147#  Command SpinBox::cget
148# ------------------------------------------------------------------------------
149proc SpinBox::cget { path option } {
150    return [Widget::cget $path $option]
151}
152
153
154# ------------------------------------------------------------------------------
155#  Command SpinBox::setvalue
156# ------------------------------------------------------------------------------
157proc SpinBox::setvalue { path index } {
158    variable _widget
159
160    set values [Widget::getoption $path -values]
161    set value  [Entry::cget $path.e -text]
162
163    if { [llength $values] } {
164        # --- -values SpinBox ---
165        switch -- $index {
166            next {
167                if { [set idx [lsearch $values $value]] != -1 } {
168                    incr idx
169                } elseif { [set idx [lsearch $values "$value*"]] == -1 } {
170                    set idx [lsearch $values $_widget($path,curval)]
171                }
172            }
173            previous {
174                if { [set idx [lsearch $values $value]] != -1 } {
175                    incr idx -1
176                } elseif { [set idx [lsearch $values "$value*"]] == -1 } {
177                    set idx [lsearch $values $_widget($path,curval)]
178                }
179            }
180            first {
181                set idx 0
182            }
183            last {
184                set idx [expr {[llength $values]-1}]
185            }
186            default {
187                if { [string index $index 0] == "@" } {
188                    set idx [string range $index 1 end]
189                    if { [catch {string compare [expr {int($idx)}] $idx} res] || $res != 0 } {
190                        return -code error "bad index \"$index\""
191                    }
192                } else {
193                    return -code error "bad index \"$index\""
194                }
195            }
196        }
197        if { $idx >= 0 && $idx < [llength $values] } {
198            set newval [lindex $values $idx]
199        } else {
200            return 0
201        }
202    } else {
203        # --- -range SpinBox ---
204        set range [Widget::getoption $path -range]
205        set vmin  [lindex $range 0]
206        set vmax  [lindex $range 1]
207        set incr  [lindex $range 2]
208        switch -- $index {
209            next {
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            previous {
222                if { [catch {expr {double($value-$vmin)/$incr}} idx] } {
223                    set newval $_widget($path,curval)
224                } else {
225                    set newval [expr {$vmin+(round($idx)-1)*$incr}]
226                    if { $newval < $vmin } {
227                        set newval $vmin
228                    } elseif { $newval > $vmax } {
229                        set newval $vmax
230                    }
231                }
232            }
233            first {
234                set newval $vmin
235            }
236            last {
237                set newval $vmax
238            }
239            default {
240                if { [string index $index 0] == "@" } {
241                    set idx [string range $index 1 end]
242                    if { [catch {string compare [expr {int($idx)}] $idx} res] || $res != 0 } {
243                        return -code error "bad index \"$index\""
244                    }
245                    set newval [expr {$vmin+int($idx)*$incr}]
246                    if { $newval < $vmin || $newval > $vmax } {
247                        return 0
248                    }
249                } else {
250                    return -code error "bad index \"$index\""
251                }
252            }
253        }
254    }
255    set _widget($path,curval) $newval
256    Widget::setoption $path -text $newval
257    if { [set varname [Entry::cget $path.e -textvariable]] != "" } {
258        GlobalVar::setvar $varname $newval
259    } else {
260        Entry::configure $path.e -text $newval
261    }
262    return 1
263}
264
265
266# ------------------------------------------------------------------------------
267#  Command SpinBox::getvalue
268# ------------------------------------------------------------------------------
269proc SpinBox::getvalue { path } {
270    variable _widget
271
272    set values [Widget::getoption $path -values]
273    set value  [Entry::cget $path.e -text]
274
275    if { [llength $values] } {
276        # --- -values SpinBox ---
277        return  [lsearch $values $value]
278    } else {
279        set range [Widget::getoption $path -range]
280        set vmin  [lindex $range 0]
281        set vmax  [lindex $range 1]
282        set incr  [lindex $range 2]
283        if { ![catch {expr {double($value-$vmin)/$incr}} idx] &&
284             $idx == int($idx) } {
285            return [expr {int($idx)}]
286        }
287        return -1
288    }
289}
290
291
292# ------------------------------------------------------------------------------
293#  Command SpinBox::bind
294# ------------------------------------------------------------------------------
295proc SpinBox::bind { path args } {
296    return [eval ::bind $path.e $args]
297}
298
299
300# ------------------------------------------------------------------------------
301#  Command SpinBox::_destroy
302# ------------------------------------------------------------------------------
303proc SpinBox::_destroy { path } {
304    variable _widget
305
306    unset _widget($path,curval)
307    Widget::destroy $path
308    rename $path {}
309}
310
311
312# ------------------------------------------------------------------------------
313#  Command SpinBox::_modify_value
314# ------------------------------------------------------------------------------
315proc SpinBox::_modify_value { path direction reason } {
316    if { $reason == "arm" || $reason == "activate" } {
317        SpinBox::setvalue $path $direction
318    }
319    if { ($reason == "disarm" || $reason == "activate") &&
320         [set cmd [Widget::getoption $path -modifycmd]] != "" } {
321        uplevel \#0 $cmd
322    }
323}
324
325
326# ------------------------------------------------------------------------------
327#  Command SpinBox::_test_options
328# ------------------------------------------------------------------------------
329proc SpinBox::_test_options { path } {
330    variable _widget
331
332    set values [Widget::getoption $path -values]
333    if { [llength $values] } {
334        set _widget($path,curval) [lindex $values 0]
335    } else {
336        set range [Widget::getoption $path -range]
337        set vmin  [lindex $range 0]
338        set vmax  [lindex $range 1]
339        set incr  [lindex $range 2]
340        if { [catch {expr {int($vmin)}}] } {
341            set vmin 0
342        }
343        if { [catch {expr {$vmax<$vmin}} res] || $res } {
344            set vmax $vmin
345        }
346        if { [catch {expr {$incr<0}} res] || $res } {
347            set incr 1
348        }
349        Widget::setoption $path -range [list $vmin $vmax $incr]
350        set _widget($path,curval) $vmin
351    }
352}
353
Note: See TracBrowser for help on using the repository browser.