Context Navigation

source: branches/1.4/gui/scripts/choiceentry.tcl @ 5312

Last change on this file since 5312 was 3647, checked in by gah, 12 years ago
add string trim to inputs
File size: 11.3 KB

Line
1	# -- mode: tcl; indent-tabs-mode: nil --
2	# ----------------------------------------------------------------------
3	# COMPONENT: ChoiceEntry - widget for entering a choice of strings
4	#
5	# This widget represents a <choice> entry on a control panel.
6	# It is used to choose one of several mutually-exclusive strings.
7	# ======================================================================
8	# AUTHOR: Michael McLennan, Purdue University
9	# Copyright (c) 2004-2012 HUBzero Foundation, LLC
10	#
11	# See the file "license.terms" for information on usage and
12	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13	# ======================================================================
14	package require Itk
15
16	itcl::class Rappture::ChoiceEntry {
17	inherit itk::Widget
18
19	itk_option define -state state State "normal"
20
21	constructor {owner path args} { # defined below }
22	destructor { # defined below }
23
24	public method value {args}
25
26	public method label {}
27	public method tooltip {}
28
29	protected method _rebuild {}
30	protected method _newValue {}
31	protected method _tooltip {}
32	protected method _log {}
33
34	private variable _owner "" ;# thing managing this control
35	private variable _path "" ;# path in XML to this number
36	private variable _str2val ;# maps option label => option value
37	}
38
39	itk::usual ChoiceEntry {
40	keep -cursor -font
41	keep -foreground -background
42	keep -textforeground -textbackground
43	keep -selectbackground -selectforeground -selectborderwidth
44	}
45
46	# ----------------------------------------------------------------------
47	# CONSTRUCTOR
48	# ----------------------------------------------------------------------
49	itcl::body Rappture::ChoiceEntry::constructor {owner path args} {
50	if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 \|\| !$valid} {
51	error "bad object \"$owner\": should be Rappture::ControlOwner"
52	}
53	set _owner $owner
54	set _path $path
55
56	#
57	# Create the widget and configure it properly based on other
58	# hints in the XML.
59	#
60	itk_component add choice {
61	Rappture::Combobox $itk_interior.choice -editable no \
62	-interactcommand [itcl::code $this _log]
63	}
64	pack $itk_component(choice) -expand yes -fill both
65	bind $itk_component(choice) <<Value>> [itcl::code $this _newValue]
66
67	eval itk_initialize $args
68
69	_rebuild
70	}
71
72	# ----------------------------------------------------------------------
73	# DESTRUCTOR
74	# ----------------------------------------------------------------------
75	itcl::body Rappture::ChoiceEntry::destructor {} {
76	$_owner notify remove $this
77	}
78
79	# ----------------------------------------------------------------------
80	# USAGE: value ?-check? ?<newval>?
81	#
82	# Clients use this to query/set the value for this widget. With
83	# no args, it returns the current value for the widget. If the
84	# <newval> is specified, it sets the value of the widget and
85	# sends a <<Value>> event. If the -check flag is included, the
86	# new value is not actually applied, but just checked for correctness.
87	# ----------------------------------------------------------------------
88	itcl::body Rappture::ChoiceEntry::value {args} {
89	set onlycheck 0
90	set i [lsearch -exact $args -check]
91	if {$i >= 0} {
92	set onlycheck 1
93	set args [lreplace $args $i $i]
94	}
95
96	if {[llength $args] == 1} {
97	if {$onlycheck} {
98	# someday we may add validation...
99	return
100	}
101	set newval [lindex $args 0]
102	if {[info exists _str2val($newval)]} {
103	# this is a label -- use it directly
104	$itk_component(choice) value $newval
105	set newval $_str2val($newval) ;# report the actual value
106	} else {
107	# this is a value -- search for corresponding label
108	foreach str [array names _str2val] {
109	if {$_str2val($str) eq $newval} {
110	$itk_component(choice) value $str
111	break
112	}
113	}
114	}
115	return $newval
116
117	} elseif {[llength $args] != 0} {
118	error "wrong # args: should be \"value ?-check? ?newval?\""
119	}
120
121	#
122	# Query the value and return.
123	#
124	set str [$itk_component(choice) value]
125	if {[info exists _str2val($str)]} {
126	return $_str2val($str)
127	}
128	return $str
129	}
130
131	# ----------------------------------------------------------------------
132	# USAGE: label
133	#
134	# Clients use this to query the label associated with this widget.
135	# Reaches into the XML and pulls out the appropriate label string.
136	# ----------------------------------------------------------------------
137	itcl::body Rappture::ChoiceEntry::label {} {
138	set label [string trim [$_owner xml get $_path.about.label]]
139	if {"" == $label} {
140	set label "Choice"
141	}
142	return $label
143	}
144
145	# ----------------------------------------------------------------------
146	# USAGE: tooltip
147	#
148	# Clients use this to query the tooltip associated with this widget.
149	# Reaches into the XML and pulls out the appropriate description
150	# string. Returns the string that should be used with the
151	# Rappture::Tooltip facility.
152	# ----------------------------------------------------------------------
153	itcl::body Rappture::ChoiceEntry::tooltip {} {
154	# query tooltip on-demand based on current choice
155	return "@[itcl::code $this _tooltip]"
156	}
157
158	# ----------------------------------------------------------------------
159	# USAGE: _rebuild
160	#
161	# Used internally to rebuild the contents of this choice widget
162	# whenever something that it depends on changes. Scans through the
163	# information in the XML spec and builds a list of choices for the
164	# widget.
165	# ----------------------------------------------------------------------
166	itcl::body Rappture::ChoiceEntry::_rebuild {} {
167	# get rid of any existing choices
168	$itk_component(choice) choices delete 0 end
169	catch {unset _str2val}
170
171	#
172	# Plug in the various options for the choice.
173	#
174	set max 10
175	foreach cname [$_owner xml children -type option $_path] {
176	set path [string trim [$_owner xml get $_path.$cname.path]]
177	if {"" != $path} {
178	# look for the input element controlling this path
179	set found 0
180	foreach cntl [Rappture::entities [$_owner xml object] "input"] {
181	set len [string length $cntl]
182	if {[string equal -length $len $cntl $path]} {
183	set found 1
184	break
185	}
186	}
187	if {$found} {
188	#
189	# Choice comes from a list of matching entities at
190	# a particular XML path. Use the <label> as a template
191	# for each item on the path.
192	#
193	$_owner notify add $this $cntl [itcl::code $this _rebuild]
194
195	set label \
196	[string trim [$_owner xml get $_path.$cname.about.label]]
197	if {"" == $label} {
198	set label "%type #%n"
199	}
200
201	set ppath [Rappture::LibraryObj::path2list $path]
202	set leading [join [lrange $ppath 0 end-1] .]
203	set tail [lindex $ppath end]
204	set n 1
205	foreach ccname [$_owner xml children $leading] {
206	if {[string match $tail $ccname]} {
207	set subst(%n) $n
208	set subst(%type) [$_owner xml element -as type $leading.$ccname]
209	set subst(%id) [$_owner xml element -as id $leading.$ccname]
210	foreach detail [$_owner xml children $leading.$ccname] {
211	set subst(%$detail) \
212	[$_owner xml get $leading.$ccname.$detail]
213	}
214	set str [string map [array get subst] $label]
215	$itk_component(choice) choices insert end \
216	$leading.$ccname $str
217	incr n
218	}
219	}
220	$itk_component(choice) value ""
221	} else {
222	puts "can't find controlling entity for path \"$path\""
223	}
224	} else {
225	#
226	# Choice is an ordinary LABEL.
227	# Add the label as-is into the list of choices.
228	#
229	set val [string trim [$_owner xml get $_path.$cname.value]]
230	set str [string trim [$_owner xml get $_path.$cname.about.label]]
231	if {"" == $val} {
232	set val $str
233	}
234	if {"" != $str} {
235	set _str2val($str) $val
236	$itk_component(choice) choices insert end $_path.$cname $str
237	set len [string length $str]
238	if {$len > $max} { set max $len }
239	}
240	}
241	}
242	$itk_component(choice) configure -width $max
243
244	#
245	# Assign the default value to this widget, if there is one.
246	#
247	set defval [string trim [$_owner xml get $_path.default]]
248	if {"" != $defval} {
249	if {[info exists _str2val($defval)]} {
250	$itk_component(choice) value $defval
251	} else {
252	foreach str [array names _str2val] {
253	if {$_str2val($str) == $defval} {
254	$itk_component(choice) value $str
255	break
256	}
257	}
258	}
259	}
260	}
261
262	# ----------------------------------------------------------------------
263	# USAGE: _newValue
264	#
265	# Invoked automatically whenever the value in the choice changes.
266	# Sends a <<Value>> event to notify clients of the change.
267	# ----------------------------------------------------------------------
268	itcl::body Rappture::ChoiceEntry::_newValue {} {
269	event generate $itk_component(hull) <<Value>>
270	}
271
272	# ----------------------------------------------------------------------
273	# USAGE: _tooltip
274	#
275	# Returns the tooltip for this widget, given the current choice in
276	# the selector. This is normally called by the Rappture::Tooltip
277	# facility whenever it is about to pop up a tooltip for this widget.
278	# ----------------------------------------------------------------------
279	itcl::body Rappture::ChoiceEntry::_tooltip {} {
280	set tip [string trim [$_owner xml get $_path.about.description]]
281
282	# get the description for the current choice, if there is one
283	set str [$itk_component(choice) value]
284	set path [$itk_component(choice) translate $str]
285	set desc ""
286	if {$path != ""} {
287	set desc [string trim [$_owner xml get $path.about.description]]
288	}
289
290	if {[string length $str] > 0 && [string length $desc] > 0} {
291	append tip "\n\n$str:\n$desc"
292	}
293	return $tip
294	}
295
296	# ----------------------------------------------------------------------
297	# USAGE: _log
298	#
299	# Used internally to send info to the logging mechanism. Calls the
300	# Rappture::Logger mechanism to log the change to this input.
301	# ----------------------------------------------------------------------
302	itcl::body Rappture::ChoiceEntry::_log {} {
303	Rappture::Logger::log input $_path [$itk_component(choice) value]
304	}
305
306	# ----------------------------------------------------------------------
307	# CONFIGURATION OPTION: -state
308	# ----------------------------------------------------------------------
309	itcl::configbody Rappture::ChoiceEntry::state {
310	set valid {normal disabled}
311	if {[lsearch -exact $valid $itk_option(-state)] < 0} {
312	error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
313	}
314	$itk_component(choice) configure -state $itk_option(-state)
315	}

Note: See TracBrowser for help on using the repository browser.

Download in other formats: