1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
# $Id: spinent.tcl,v 2.6 2003/08/25 09:28:55 jfontain Exp $
class spinEntry {}
proc spinEntry::spinEntry {this parentPath args} composite {
[new frame $parentPath -highlightthickness $widget::option(button,highlightthickness)] $args
} {
::set path $widget::($this,path)
# prevent the arrow buttons from ever getting the focus
composite::manage $this [new entry $path -highlightthickness 0] entry\
[new arrowButton $path\
-takefocus 0 -command "spinEntry::decrease $this" -height 4 -highlightthickness 0\
-repeatdelay $widget::option(scrollbar,repeatdelay)\
] decrease\
[new arrowButton $path\
-direction up -takefocus 0 -command "spinEntry::increase $this" -height 4 -highlightthickness 0\
-repeatdelay $widget::option(scrollbar,repeatdelay)\
] increase
# the following bindings get activated when either the main button or the entry get the focus
bind $path <Return> "spinEntry::invoke $this"
bind $path <KP_Enter> "spinEntry::invoke $this"
bind $composite::($this,entry,path) <Return> "spinEntry::invoke $this"
bind $composite::($this,entry,path) <KP_Enter> "spinEntry::invoke $this"
# either entry or widget will get the focus so setup key bindings for both of them
spinEntry::setupUpAndDownKeysBindings $this $path
spinEntry::setupUpAndDownKeysBindings $this $composite::($this,entry,path)
composite::complete $this
}
proc spinEntry::~spinEntry {this} {}
proc spinEntry::options {this} { ;# force initialization on font, side and state options
return [list\
[list -command {} {}]\
[list -editable 1 1]\
[list -font $widget::option(button,font)]\
[list -justify $widget::option(entry,justify) $widget::option(entry,justify)]\
[list -list {} {}]\
[list -range {} {}]\
[list -repeatdelay $widget::option(scrollbar,repeatdelay) $widget::option(scrollbar,repeatdelay)]\
[list -side left]\
[list -state normal]\
[list -width $widget::option(entry,width) $widget::option(entry,width)]\
[list -wrap 0 0]\
]
}
proc spinEntry::set-command {this value} {} ;# do nothing, command is stored at the composite level
proc spinEntry::set-editable {this value} {
setStatesAndBindings $this
}
proc spinEntry::set-list {this value} {
if {$composite::($this,complete)} {
error {option -orient cannot be set dynamically}
}
if {[string length [$composite::($this,entry,path) get]] == 0} { ;# if not done yet, initialize value with first element
set $this [lindex $value 0]
}
}
proc spinEntry::set-range {this value} {
if {$composite::($this,complete)} {
error {option -range cannot be set dynamically}
}
if {[llength $value] != 3} {
error {option -range argument format must be {minimum maximum increment}}
}
::set ($this,minimum) [lindex $composite::($this,-range) 0]
::set ($this,maximum) [lindex $composite::($this,-range) 1]
::set ($this,increment) [lindex $composite::($this,-range) 2]
if {[catch {expr {$($this,maximum) - $($this,minimum) + $($this,increment)}}]} {
error {option -range arguments must be numeric values}
}
if {[string length [$composite::($this,entry,path) get]] == 0} { ;# if not done yet, initialize value with minimum
set $this $($this,minimum)
}
}
proc spinEntry::set-repeatdelay {this value} {
widget::configure $composite::($this,decrease) -repeatdelay $value
widget::configure $composite::($this,increase) -repeatdelay $value
}
proc spinEntry::set-state {this value} {
if {![regexp {^(disabled|normal)$} $value]} {
error "bad state value \"$value\": must be normal or disabled"
}
setStatesAndBindings $this
}
foreach option {-font -justify -width} {
proc spinEntry::set$option {this value} "\$composite::(\$this,entry,path) configure $option \$value"
}
proc spinEntry::set-side {this value} { ;# specifies on which side of the arrow buttons the entry should be
if {![regexp {^(left|right)$} $value]} {
error "bad side value \"$value\": must be left or right"
}
pack forget $composite::($this,entry,path) $composite::($this,increase,path) $composite::($this,decrease,path)
pack $composite::($this,entry,path) -side $value -fill both -expand 1
pack $composite::($this,increase,path) $composite::($this,decrease,path) -fill y -expand 1
}
proc spinEntry::set-wrap {this value} {} ;# do nothing, command is stored at the composite level
# only now that the widget is in a final state (since the user was able to interact with it) can we do some validity checking
proc spinEntry::decrease {this} {
set $this [spinEntry::next $this -1]
invoke $this down
}
proc spinEntry::increase {this} {
set $this [spinEntry::next $this 1]
invoke $this up
}
proc spinEntry::next {this direction} {
::set value [$composite::($this,entry,path) get]
::set wrap $composite::($this,-wrap)
if {[catch {::set increment $($this,increment)}]} { ;# list mode
::set index [lsearch -exact $composite::($this,-list) $value] ;# try to find the current value index
incr index $direction ;# note: if not found, we restart at one extremity of the list
if {$index < 0} {
if {$wrap} {::set index end} else {::set index 0}
} elseif {$index >= [llength $composite::($this,-list)]} {
if {$wrap} {::set index 0} else {::set index end}
}
return [lindex $composite::($this,-list) $index]
} else { ;# range mode
::set minimum $($this,minimum)
::set maximum $($this,maximum)
if {[catch {expr {$value + 0}}]} { ;# if entry is editable, contents may not be a valid number
return [expr {$direction < 0? $minimum: $maximum}]
} else {
::set value [expr {$value + ($direction * $increment)}]
if {$value <= $minimum} {
if {$wrap} {return $maximum} else {return $minimum}
} elseif {$value >= $maximum} {
if {$wrap} {return $minimum} else {return $maximum}
} else {
return $value
}
}
}
}
proc spinEntry::setStatesAndBindings {this} {
if {[string equal $composite::($this,-state) normal]} {
widget::configure $composite::($this,decrease) -state normal
widget::configure $composite::($this,increase) -state normal
if {$composite::($this,-editable)} {
$widget::($this,path) configure -takefocus 0 ;# let entry get the focus
$composite::($this,entry,path) configure -state normal
} else {
$widget::($this,path) configure -takefocus 1 ;# main widget gets the focus
$composite::($this,entry,path) configure -state disabled
}
$composite::($this,entry,path) configure -foreground $widget::option(entry,foreground)
} else {
$widget::($this,path) configure -takefocus 0
widget::configure $composite::($this,decrease) -state disabled
widget::configure $composite::($this,increase) -state disabled
widget::configure $composite::($this,entry) -state disabled
$composite::($this,entry,path) configure -foreground $widget::option(label,disabledforeground)
}
}
proc spinEntry::setupUpAndDownKeysBindings {this path} {
# handle arrow keys events and make arrow buttons match key movements
bind $path <KeyPress-Down> "arrowButton::sink $composite::($this,decrease); spinEntry::decrease $this"
bind $path <KeyRelease-Down> "arrowButton::raise $composite::($this,decrease)"
bind $path <KeyPress-Up> "arrowButton::sink $composite::($this,increase); spinEntry::increase $this"
bind $path <KeyRelease-Up> "arrowButton::raise $composite::($this,increase)"
}
proc spinEntry::invoke {this {direction none}} {
::set command $composite::($this,-command)
if {[string length $command] > 0} { ;# always invoke command at global level as tk buttons do
regsub -all %d $command $direction command
uplevel #0 $command [list [$composite::($this,entry,path) get]]
}
}
proc spinEntry::set {this text} { ;# public procedure for setting entry contents
::set path $composite::($this,entry,path)
$path configure -state normal ;# entry may not be in an editable state
$path delete 0 end
$path insert 0 $text
if {!$composite::($this,-editable)} {
$path configure -state disabled ;# eventually restore entry state
}
}
proc spinEntry::get {this} { ;# public procedure for retrieving entry contents
return [$composite::($this,entry,path) get]
}
|
