source: trunk/gui/scripts/dropdownlist.tcl @ 1

Last change on this file since 1 was 1, checked in by mmc, 17 years ago

initial import

File size: 10.5 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: dropdownlist - drop-down list of items
3#
4#  This is a drop-down listbox, which might be used in conjunction
5#  with a combobox.
6#
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
10# ======================================================================
11package require Itk
12
13option add *Dropdownlist.textBackground white widgetDefault
14option add *Dropdownlist.outline black widgetDefault
15option add *Dropdownlist.borderwidth 1 widgetDefault
16option add *Dropdownlist.relief flat widgetDefault
17option add *Dropdownlist.font \
18    -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
19
20itcl::class Rappture::Dropdownlist {
21    inherit Rappture::Dropdown
22
23    constructor {args} { # defined below }
24
25    public method insert {pos args}
26    public method delete {first {last ""}}
27    public method index {args}
28    public method get {args}
29    public method size {}
30    public method select {option args}
31    public method current {{what -value}}
32
33    private variable _values ""  ;# values for all elems in list
34    private variable _labels ""  ;# labels for each of the _values
35
36    protected method _adjust {{widget ""}}
37    protected method _react {}
38}
39
40itk::usual Dropdownlist {
41    keep -background -outline -cursor -font
42}
43
44# ----------------------------------------------------------------------
45# CONSTRUCTOR
46# ----------------------------------------------------------------------
47itcl::body Rappture::Dropdownlist::constructor {args} {
48    itk_component add scroller {
49        Rappture::Scroller $itk_interior.sc \
50            -xscrollmode off -yscrollmode auto
51    }
52    pack $itk_component(scroller) -expand yes -fill both
53
54    itk_component add list {
55        listbox $itk_component(scroller).list \
56            -selectmode single -exportselection no \
57            -highlightthickness 0
58    } {
59        usual
60        rename -background -textbackground textBackground Background
61        rename -foreground -textforeground textForeground Foreground
62        ignore -highlightthickness -highlightbackground -highlightcolor
63        keep -relief
64    }
65    $itk_component(scroller) contents $itk_component(list)
66
67    # add bindings so the listbox can react to selections
68    bind RapptureDropdownlist-$this <ButtonRelease> [itcl::code $this _react]
69    bind RapptureDropdownlist-$this <KeyPress-Return> [itcl::code $this _react]
70    bind RapptureDropdownlist-$this <KeyPress-space> [itcl::code $this _react]
71    bind RapptureDropdownlist-$this <KeyPress-Escape> [itcl::code $this unpost]
72
73    set btags [bindtags $itk_component(list)]
74    set i [lsearch $btags [winfo class $itk_component(list)]]
75    if {$i < 0} {
76        set i end
77    }
78    set btags [linsert $btags [expr {$i+1}] RapptureDropdownlist-$this]
79    bindtags $itk_component(list) $btags
80
81    eval itk_initialize $args
82}
83
84# ----------------------------------------------------------------------
85# USAGE: insert <pos> ?<value1> <label1> <value2> <label2> ...?
86#
87# Inserts one or more values into this drop-down list.  Each value
88# has a keyword (computer-friendly value) and a label (human-friendly
89# value).  The labels appear in the listbox.  If the label is "--",
90# then the value is used as the label.
91# ----------------------------------------------------------------------
92itcl::body Rappture::Dropdownlist::insert {pos args} {
93    if {"end" == $pos} {
94        set pos [llength $_values]
95    } elseif {![string is integer -strict $pos]} {
96        error "bad index \"$pos\": should be integer or \"end\""
97    }
98
99    if {[llength $args] == 1} {
100        set args [lindex $args 0]
101    }
102    if {[llength $args] % 2 != 0} {
103        error "wrong # args: should be \"insert pos ?value label ...?\""
104    }
105
106    foreach {val label} $args {
107        if {$label == "--"} {
108            set label $val
109        }
110        set _values [linsert $_values $pos $val]
111        set _labels [linsert $_labels $pos $label]
112        $itk_component(list) insert $pos $label
113        incr pos
114    }
115}
116
117# ----------------------------------------------------------------------
118# USAGE: delete <first> ?<last>?
119#
120# Deletes one or more values from this drop-down list.  The indices
121# <first> and <last> should be integers from 0 or the keyword "end".
122# All values in the specified range are deleted.
123# ----------------------------------------------------------------------
124itcl::body Rappture::Dropdownlist::delete {first {last ""}} {
125    if {$last == ""} {
126        set last $first
127    }
128    if {![regexp {^[0-9]+|end$} $first]} {
129        error "bad index \"$first\": should be integer or \"end\""
130    }
131    if {![regexp {^[0-9]+|end$} $last]} {
132        error "bad index \"$last\": should be integer or \"end\""
133    }
134
135    set _values [lreplace $_values $first $last]
136    set _labels [lreplace $_labels $first $last]
137}
138
139# ----------------------------------------------------------------------
140# USAGE: index ?-value|-label? <value>
141#
142# Returns the integer index for the position of the specified <value>
143# in the list.  Returns -1 if the value is not recognized.
144# ----------------------------------------------------------------------
145itcl::body Rappture::Dropdownlist::index {args} {
146    set format -value
147    set first [lindex $args 0]
148    if {$first == "-value" || $first == "-label"} {
149        set format $first
150        set args [lrange $args 1 end]
151    } elseif {[llength $args] > 1} {
152        error "bad option \"$first\": should be -value or -label"
153    }
154    if {[llength $args] != 1} {
155        error "wrong # args: should be \"index ?-value? ?-label? string\""
156    }
157    set value [lindex $args 0]
158
159    switch -- $format {
160        -value { return [lsearch -exact $_values $value] }
161        -label { return [lsearch -exact $_labels $value] }
162    }
163    return -1
164}
165
166# ----------------------------------------------------------------------
167# USAGE: get ?-value|-label|-both? ?<index>?
168#
169# Queries one or more values from the drop-down list.  With no args,
170# it returns a list of all values and labels in the list.  If the
171# index is specified, then it returns the value or label (or both)
172# for the specified index.
173# ----------------------------------------------------------------------
174itcl::body Rappture::Dropdownlist::get {args} {
175    set format -both
176    set first [lindex $args 0]
177    if {[string index $first 0] == "-"} {
178        set choices {-value -label -both}
179        if {[lsearch $choices $first] < 0} {
180            error "bad option \"$first\": should be [join [lsort $choices] {, }]"
181        }
182        set format $first
183        set args [lrange $args 1 end]
184    }
185
186    # return the whole list or just a single value
187    if {[llength $args] > 1} {
188        error "wrong # args: should be \"get ?-value|-label|-both? ?index?\""
189    }
190    if {[llength $args] == 0} {
191        set vlist $_values
192        set llist $_labels
193        set op lappend
194    } else {
195        set i [lindex $args 0]
196        set vlist [list [lindex $_values $i]]
197        set llist [list [lindex $_labels $i]]
198        set op set
199    }
200
201    # scan through and build up the return list
202    set rlist ""
203    foreach v $vlist l $llist {
204        switch -- $format {
205            -value { $op rlist $v }
206            -label { $op rlist $l }
207            -both  { lappend rlist $v $l }
208        }
209    }
210    return $rlist
211}
212
213# ----------------------------------------------------------------------
214# USAGE: size
215#
216# Returns the number of choices in this list.
217# ----------------------------------------------------------------------
218itcl::body Rappture::Dropdownlist::size {} {
219    return [llength $_values]
220}
221
222# ----------------------------------------------------------------------
223# USAGE: select <option> ?<arg> ...?
224#
225# Used to manipulate the selection in the listbox.  All options and
226# args are passed along to the underlying listbox.
227# ----------------------------------------------------------------------
228itcl::body Rappture::Dropdownlist::select {option args} {
229    if {$option == "set"} {
230        $itk_component(list) activate [lindex $args 0]
231    }
232    eval $itk_component(list) selection $option $args
233}
234
235# ----------------------------------------------------------------------
236# USAGE: current ?-value|-label|-both?
237#
238# Clients use this to query the current selection from the listbox.
239# Returns the value, label, or both, according to the option.
240# ----------------------------------------------------------------------
241itcl::body Rappture::Dropdownlist::current {{what -value}} {
242    set i [$itk_component(list) curselection]
243    if {$i != ""} {
244        switch -- $what {
245            -value { return [lindex $_values $i] }
246            -label { return [lindex $_labels $i] }
247            -both  { return [list [lindex $_values $i] [lindex $_labels $i]] }
248            default {
249                error "bad option \"$what\": should be -value, -label, -both"
250            }
251        }
252    }
253    return ""
254}
255
256# ----------------------------------------------------------------------
257# USAGE: _adjust ?<widget>?
258#
259# This method is invoked each time the dropdown is posted to adjust
260# its size and contents.  If the <widget> is specified, it is the
261# controlling widget.
262# ----------------------------------------------------------------------
263itcl::body Rappture::Dropdownlist::_adjust {{widget ""}} {
264    chain $widget
265
266    set fnt [$itk_component(list) cget -font]
267    set maxw 0
268    foreach str $_labels {
269        set w [font measure $fnt $str]
270        if {$w > $maxw} { set maxw $w }
271    }
272    if {$widget != ""} {
273        if {$maxw < [winfo width $widget]} { set maxw [winfo width $widget] }
274    }
275    set avg [font measure $fnt "x"]
276    $itk_component(list) configure -width [expr {round($maxw/double($avg))+1}]
277
278    if {$widget != ""} {
279        set y [expr {[winfo rooty $widget]+[winfo height $widget]}]
280        set h [font metrics $fnt -linespace]
281        set lines [expr {double([winfo screenheight $widget]-$y)/$h}]
282        if {[llength $_labels] < $lines} {
283            $itk_component(list) configure -height [llength $_labels]
284        } else {
285            $itk_component(list) configure -height 10
286        }
287    }
288
289    focus $itk_component(list)
290}
291
292# ----------------------------------------------------------------------
293# USAGE: _react
294#
295# Invoked automatically when the user has selected something from
296# the listbox.  Unposts the drop-down and generates an event letting
297# the client know that the selection has changed.
298# ----------------------------------------------------------------------
299itcl::body Rappture::Dropdownlist::_react {} {
300    unpost
301    event generate $itk_component(hull) <<DropdownlistSelect>>
302}
Note: See TracBrowser for help on using the repository browser.