1 | # ------------------------------------------------------------------------------ |
---|
2 | # combobox.tcl |
---|
3 | # This file is part of Unifix BWidget Toolkit |
---|
4 | # $Id: combobox.tcl,v 1.6 1999/07/09 08:10:27 eric Exp $ |
---|
5 | # ------------------------------------------------------------------------------ |
---|
6 | # Index of commands: |
---|
7 | # - ComboBox::create |
---|
8 | # - ComboBox::configure |
---|
9 | # - ComboBox::cget |
---|
10 | # - ComboBox::setvalue |
---|
11 | # - ComboBox::getvalue |
---|
12 | # - ComboBox::_create_popup |
---|
13 | # - ComboBox::_mapliste |
---|
14 | # - ComboBox::_unmapliste |
---|
15 | # - ComboBox::_select |
---|
16 | # - ComboBox::_modify_value |
---|
17 | # ------------------------------------------------------------------------------ |
---|
18 | |
---|
19 | namespace eval ComboBox { |
---|
20 | ArrowButton::use |
---|
21 | Entry::use |
---|
22 | LabelFrame::use |
---|
23 | |
---|
24 | Widget::bwinclude ComboBox LabelFrame .labf \ |
---|
25 | rename {-text -label} \ |
---|
26 | remove {-focus} \ |
---|
27 | prefix {label -justify -width -anchor -height -font} \ |
---|
28 | initialize {-relief sunken -borderwidth 2} |
---|
29 | |
---|
30 | Widget::bwinclude ComboBox Entry .e \ |
---|
31 | remove {-relief -bd -borderwidth -bg -fg} \ |
---|
32 | rename {-foreground -entryfg -background -entrybg} |
---|
33 | |
---|
34 | Widget::declare ComboBox { |
---|
35 | {-height TkResource 0 0 listbox} |
---|
36 | {-values String "" 0} |
---|
37 | {-modifycmd String "" 0} |
---|
38 | {-postcommand String "" 0} |
---|
39 | } |
---|
40 | |
---|
41 | Widget::addmap ComboBox "" :cmd {-background {}} |
---|
42 | Widget::addmap ComboBox ArrowButton .a \ |
---|
43 | {-foreground {} -background {} -disabledforeground {} -state {}} |
---|
44 | |
---|
45 | Widget::syncoptions ComboBox Entry .e {-text {}} |
---|
46 | Widget::syncoptions ComboBox LabelFrame .labf {-label -text -underline {}} |
---|
47 | |
---|
48 | ::bind BwComboBox <FocusIn> {focus %W.labf} |
---|
49 | ::bind BwComboBox <Destroy> {Widget::destroy %W; rename %W {}} |
---|
50 | |
---|
51 | proc ::ComboBox { path args } { return [eval ComboBox::create $path $args] } |
---|
52 | proc use {} {} |
---|
53 | } |
---|
54 | |
---|
55 | |
---|
56 | # ------------------------------------------------------------------------------ |
---|
57 | # Command ComboBox::create |
---|
58 | # ------------------------------------------------------------------------------ |
---|
59 | proc ComboBox::create { path args } { |
---|
60 | Widget::init ComboBox $path $args |
---|
61 | |
---|
62 | frame $path -background [Widget::getoption $path -background] \ |
---|
63 | -highlightthickness 0 -bd 0 -relief flat -takefocus 0 |
---|
64 | |
---|
65 | bindtags $path [list $path BwComboBox [winfo toplevel $path] all] |
---|
66 | |
---|
67 | set labf [eval LabelFrame::create $path.labf [Widget::subcget $path .labf] \ |
---|
68 | -focus $path.e] |
---|
69 | set entry [eval Entry::create $path.e [Widget::subcget $path .e] \ |
---|
70 | -relief flat -borderwidth 0] |
---|
71 | |
---|
72 | set width 11 |
---|
73 | set height [winfo reqheight $entry] |
---|
74 | set arrow [eval ArrowButton::create $path.a [Widget::subcget $path .a] \ |
---|
75 | -width $width -height $height \ |
---|
76 | -highlightthickness 0 -borderwidth 1 -takefocus 0 \ |
---|
77 | -dir bottom \ |
---|
78 | -type button \ |
---|
79 | -command [list "ComboBox::_mapliste $path"]] |
---|
80 | |
---|
81 | set frame [LabelFrame::getframe $labf] |
---|
82 | |
---|
83 | pack $arrow -in $frame -side right -fill y |
---|
84 | pack $entry -in $frame -side left -fill both -expand yes |
---|
85 | pack $labf -fill x -expand yes |
---|
86 | |
---|
87 | if { [Widget::getoption $path -editable] == 0 } { |
---|
88 | ::bind $entry <ButtonPress-1> "ArrowButton::invoke $path.a" |
---|
89 | } else { |
---|
90 | ::bind $entry <ButtonPress-1> "ComboBox::_unmapliste $path" |
---|
91 | } |
---|
92 | |
---|
93 | ::bind $path <ButtonPress-1> "ComboBox::_unmapliste $path" |
---|
94 | ::bind $entry <Key-Up> "ComboBox::_modify_value $path previous" |
---|
95 | ::bind $entry <Key-Down> "ComboBox::_modify_value $path next" |
---|
96 | ::bind $entry <Key-Prior> "ComboBox::_modify_value $path first" |
---|
97 | ::bind $entry <Key-Next> "ComboBox::_modify_value $path last" |
---|
98 | |
---|
99 | rename $path ::$path:cmd |
---|
100 | proc ::$path { cmd args } "return \[eval ComboBox::\$cmd $path \$args\]" |
---|
101 | |
---|
102 | return $path |
---|
103 | } |
---|
104 | |
---|
105 | |
---|
106 | # ------------------------------------------------------------------------------ |
---|
107 | # Command ComboBox::configure |
---|
108 | # ------------------------------------------------------------------------------ |
---|
109 | proc ComboBox::configure { path args } { |
---|
110 | set res [Widget::configure $path $args] |
---|
111 | |
---|
112 | if { [Widget::hasChanged $path -values values] | |
---|
113 | [Widget::hasChanged $path -height h] | |
---|
114 | [Widget::hasChanged $path -font f] } { |
---|
115 | destroy $path.shell.listb |
---|
116 | } |
---|
117 | |
---|
118 | if { [Widget::hasChanged $path -editable ed] } { |
---|
119 | if { $ed } { |
---|
120 | ::bind $path.e <ButtonPress-1> "ComboBox::_unmapliste $path" |
---|
121 | } else { |
---|
122 | ::bind $path.e <ButtonPress-1> "ArrowButton::invoke $path.a" |
---|
123 | } |
---|
124 | } |
---|
125 | |
---|
126 | return $res |
---|
127 | } |
---|
128 | |
---|
129 | |
---|
130 | # ------------------------------------------------------------------------------ |
---|
131 | # Command ComboBox::cget |
---|
132 | # ------------------------------------------------------------------------------ |
---|
133 | proc ComboBox::cget { path option } { |
---|
134 | Widget::setoption $path -text [Entry::cget $path.e -text] |
---|
135 | return [Widget::cget $path $option] |
---|
136 | } |
---|
137 | |
---|
138 | |
---|
139 | # ------------------------------------------------------------------------------ |
---|
140 | # Command ComboBox::setvalue |
---|
141 | # ------------------------------------------------------------------------------ |
---|
142 | proc ComboBox::setvalue { path index } { |
---|
143 | set values [Widget::getoption $path -values] |
---|
144 | set value [Entry::cget $path.e -text] |
---|
145 | switch -- $index { |
---|
146 | next { |
---|
147 | if { [set idx [lsearch $values $value]] != -1 } { |
---|
148 | incr idx |
---|
149 | } else { |
---|
150 | set idx [lsearch $values "$value*"] |
---|
151 | } |
---|
152 | } |
---|
153 | previous { |
---|
154 | if { [set idx [lsearch $values $value]] != -1 } { |
---|
155 | incr idx -1 |
---|
156 | } else { |
---|
157 | set idx [lsearch $values "$value*"] |
---|
158 | } |
---|
159 | } |
---|
160 | first { |
---|
161 | set idx 0 |
---|
162 | } |
---|
163 | last { |
---|
164 | set idx [expr {[llength $values]-1}] |
---|
165 | } |
---|
166 | default { |
---|
167 | if { [string index $index 0] == "@" } { |
---|
168 | set idx [string range $index 1 end] |
---|
169 | if { [catch {string compare [expr {int($idx)}] $idx} res] || $res != 0 } { |
---|
170 | return -code error "bad index \"$index\"" |
---|
171 | } |
---|
172 | } else { |
---|
173 | return -code error "bad index \"$index\"" |
---|
174 | } |
---|
175 | } |
---|
176 | } |
---|
177 | if { $idx >= 0 && $idx < [llength $values] } { |
---|
178 | set newval [lindex $values $idx] |
---|
179 | Widget::setoption $path -text $newval |
---|
180 | if { [set varname [Entry::cget $path.e -textvariable]] != "" } { |
---|
181 | GlobalVar::setvar $varname $newval |
---|
182 | } else { |
---|
183 | Entry::configure $path.e -text $newval |
---|
184 | } |
---|
185 | return 1 |
---|
186 | } |
---|
187 | return 0 |
---|
188 | } |
---|
189 | |
---|
190 | |
---|
191 | # ------------------------------------------------------------------------------ |
---|
192 | # Command ComboBox::getvalue |
---|
193 | # ------------------------------------------------------------------------------ |
---|
194 | proc ComboBox::getvalue { path } { |
---|
195 | set values [Widget::getoption $path -values] |
---|
196 | set value [Entry::cget $path.e -text] |
---|
197 | |
---|
198 | return [lsearch $values $value] |
---|
199 | } |
---|
200 | |
---|
201 | |
---|
202 | # ------------------------------------------------------------------------------ |
---|
203 | # Command ComboBox::bind |
---|
204 | # ------------------------------------------------------------------------------ |
---|
205 | proc ComboBox::bind { path args } { |
---|
206 | return [eval ::bind $path.e $args] |
---|
207 | } |
---|
208 | |
---|
209 | |
---|
210 | # ------------------------------------------------------------------------------ |
---|
211 | # Command ComboBox::_create_popup |
---|
212 | # ------------------------------------------------------------------------------ |
---|
213 | proc ComboBox::_create_popup { path } { |
---|
214 | set shell [menu $path.shell -tearoff 0 -relief flat -bd 0] |
---|
215 | wm overrideredirect $shell 1 |
---|
216 | wm withdraw $shell |
---|
217 | wm transient $shell [winfo toplevel $path] |
---|
218 | wm group $shell [winfo toplevel $path] |
---|
219 | set lval [Widget::getoption $path -values] |
---|
220 | set h [Widget::getoption $path -height] |
---|
221 | set sb 0 |
---|
222 | if { $h <= 0 } { |
---|
223 | set len [llength $lval] |
---|
224 | if { $len < 3 } { |
---|
225 | set h 3 |
---|
226 | } elseif { $len > 10 } { |
---|
227 | set h 10 |
---|
228 | set sb 1 |
---|
229 | } |
---|
230 | } |
---|
231 | set frame [frame $shell.frame -relief sunken -bd 2] |
---|
232 | set listb [listbox $shell.listb -relief flat -bd 0 -highlightthickness 0 \ |
---|
233 | -exportselection false \ |
---|
234 | -font [Widget::getoption $path -font] \ |
---|
235 | -height $h] |
---|
236 | |
---|
237 | if { $sb } { |
---|
238 | set scroll [scrollbar $shell.scroll \ |
---|
239 | -orient vertical \ |
---|
240 | -command "$shell.listb yview" \ |
---|
241 | -highlightthickness 0 -takefocus 0 -width 9] |
---|
242 | $listb configure -yscrollcommand "$scroll set" |
---|
243 | } |
---|
244 | $listb delete 0 end |
---|
245 | foreach val $lval { |
---|
246 | $listb insert end $val |
---|
247 | } |
---|
248 | |
---|
249 | if { $sb } { |
---|
250 | pack $scroll -in $frame -side right -fill y |
---|
251 | } |
---|
252 | pack $listb -in $frame -side left -fill both -expand yes |
---|
253 | pack $frame -fill both -expand yes -padx 1 -padx 1 |
---|
254 | |
---|
255 | ::bind $listb <ButtonRelease-1> "ComboBox::_select $path @%x,%y" |
---|
256 | ::bind $listb <Return> "ComboBox::_select $path active" |
---|
257 | ::bind $listb <Escape> "ComboBox::_unmapliste $path" |
---|
258 | } |
---|
259 | |
---|
260 | |
---|
261 | # ------------------------------------------------------------------------------ |
---|
262 | # Command ComboBox::_mapliste |
---|
263 | # ------------------------------------------------------------------------------ |
---|
264 | proc ComboBox::_mapliste { path } { |
---|
265 | set listb $path.shell.listb |
---|
266 | if { [winfo exists $path.shell] } { |
---|
267 | _unmapliste $path |
---|
268 | return |
---|
269 | } |
---|
270 | |
---|
271 | if { [Widget::getoption $path -state] == "disabled" } { |
---|
272 | return |
---|
273 | } |
---|
274 | if { [set cmd [Widget::getoption $path -postcommand]] != "" } { |
---|
275 | uplevel \#0 $cmd |
---|
276 | } |
---|
277 | if { ![llength [Widget::getoption $path -values]] } { |
---|
278 | return |
---|
279 | } |
---|
280 | _create_popup $path |
---|
281 | |
---|
282 | ArrowButton::configure $path.a -dir top |
---|
283 | $listb selection clear 0 end |
---|
284 | set values [$listb get 0 end] |
---|
285 | set curval [Entry::cget $path.e -text] |
---|
286 | if { [set idx [lsearch $values $curval]] != -1 || |
---|
287 | [set idx [lsearch $values "$curval*"]] != -1 } { |
---|
288 | $listb selection set $idx |
---|
289 | $listb activate $idx |
---|
290 | $listb see $idx |
---|
291 | } else { |
---|
292 | $listb activate 0 |
---|
293 | $listb see 0 |
---|
294 | } |
---|
295 | |
---|
296 | set frame [LabelFrame::getframe $path.labf] |
---|
297 | BWidget::place $path.shell [winfo width $frame] 0 below $frame |
---|
298 | wm deiconify $path.shell |
---|
299 | raise $path.shell |
---|
300 | BWidget::grab global $path |
---|
301 | } |
---|
302 | |
---|
303 | |
---|
304 | # ------------------------------------------------------------------------------ |
---|
305 | # Command ComboBox::_unmapliste |
---|
306 | # ------------------------------------------------------------------------------ |
---|
307 | proc ComboBox::_unmapliste { path } { |
---|
308 | BWidget::grab release $path |
---|
309 | destroy $path.shell |
---|
310 | ArrowButton::configure $path.a -dir bottom |
---|
311 | } |
---|
312 | |
---|
313 | |
---|
314 | # ------------------------------------------------------------------------------ |
---|
315 | # Command ComboBox::_select |
---|
316 | # ------------------------------------------------------------------------------ |
---|
317 | proc ComboBox::_select { path index } { |
---|
318 | set index [$path.shell.listb index $index] |
---|
319 | _unmapliste $path |
---|
320 | if { $index != -1 } { |
---|
321 | if { [setvalue $path @$index] } { |
---|
322 | if { [set cmd [Widget::getoption $path -modifycmd]] != "" } { |
---|
323 | uplevel \#0 $cmd |
---|
324 | } |
---|
325 | } |
---|
326 | } |
---|
327 | return -code break |
---|
328 | } |
---|
329 | |
---|
330 | |
---|
331 | # ------------------------------------------------------------------------------ |
---|
332 | # Command ComboBox::_modify_value |
---|
333 | # ------------------------------------------------------------------------------ |
---|
334 | proc ComboBox::_modify_value { path direction } { |
---|
335 | if { [setvalue $path $direction] } { |
---|
336 | if { [set cmd [Widget::getoption $path -modifycmd]] != "" } { |
---|
337 | uplevel \#0 $cmd |
---|
338 | } |
---|
339 | } |
---|
340 | } |
---|