source: trunk/BWidget-1.2.1/combobox.tcl

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

include rest of files

File size: 11.2 KB
Line 
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
19namespace 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# ------------------------------------------------------------------------------
59proc 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# ------------------------------------------------------------------------------
109proc 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# ------------------------------------------------------------------------------
133proc 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# ------------------------------------------------------------------------------
142proc 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# ------------------------------------------------------------------------------
194proc 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# ------------------------------------------------------------------------------
205proc ComboBox::bind { path args } {
206    return [eval ::bind $path.e $args]
207}
208
209
210# ------------------------------------------------------------------------------
211#  Command ComboBox::_create_popup
212# ------------------------------------------------------------------------------
213proc 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# ------------------------------------------------------------------------------
264proc 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# ------------------------------------------------------------------------------
307proc 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# ------------------------------------------------------------------------------
317proc 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# ------------------------------------------------------------------------------
334proc 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}
Note: See TracBrowser for help on using the repository browser.