Context Navigation

source: branches/multichoice/gui/scripts/controls.tcl @ 6251

Last change on this file since 6251 was 6251, checked in by dkearney, 7 years ago
adding a new multichoice widget. similar to a choice widget, but the choices are not mutually exclusive.
File size: 33.6 KB

Line
1	# -- mode: tcl; indent-tabs-mode: nil --
2	# ----------------------------------------------------------------------
3	# COMPONENT: controls - a container for various Rappture controls
4	#
5	# This widget is a smart frame acting as a container for controls.
6	# Controls are added to this panel, and the panel itself decides
7	# how to arrange them given available space.
8	# ======================================================================
9	# AUTHOR: Michael McLennan, Purdue University
10	# Copyright (c) 2004-2012 HUBzero Foundation, LLC
11	#
12	# See the file "license.terms" for information on usage and
13	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14	# ======================================================================
15	package require Itk
16	package require BLT
17
18	option add *Controls.padding 4 widgetDefault
19	option add *Controls.labelFont \
20	--helvetica-medium-r-normal--12-* widgetDefault
21
22	itcl::class Rappture::Controls {
23	inherit itk::Widget
24
25	itk_option define -layout layout Layout ""
26	itk_option define -padding padding Padding 0
27
28	constructor {owner args} { # defined below }
29	destructor { # defined below }
30
31	public method insert {pos path}
32	public method delete {first {last ""}}
33	public method index {name}
34	public method control {args}
35	public method refresh {}
36
37	protected method _layout {}
38	protected method _monitor {name state}
39	protected method _controlChanged {name}
40	protected method _controlValue {path {units ""}}
41	protected method _formatLabel {str}
42	protected method _changeTabs {{why -program}}
43	protected method _resize {}
44
45	private variable _owner "" ;# controls belong to this owner
46	private variable _tabs "" ;# optional tabset for groups
47	private variable _frame "" ;# pack controls into this frame
48	private variable _counter 0 ;# counter for control names
49	private variable _dispatcher "" ;# dispatcher for !events
50	private variable _controls "" ;# list of known controls
51	private variable _showing "" ;# list of enabled (showing) controls
52	private variable _name2info ;# maps control name => info
53	private variable _scheme "" ;# layout scheme (tabs/vert/horz/sentence)
54	private variable _sentenceparts ;# info for layout scheme "sentence:"
55	}
56
57	itk::usual Controls {
58	}
59
60	# ----------------------------------------------------------------------
61	# CONSTRUCTOR
62	# ----------------------------------------------------------------------
63	itcl::body Rappture::Controls::constructor {owner args} {
64	Rappture::dispatcher _dispatcher
65	$_dispatcher register !layout
66	$_dispatcher dispatch $this !layout "[itcl::code $this _layout]; list"
67	$_dispatcher register !resize
68	$_dispatcher dispatch $this !resize "[itcl::code $this _resize]; list"
69
70	set _owner $owner
71
72	Rappture::Scroller $itk_interior.sc -xscrollmode none -yscrollmode auto
73	pack $itk_interior.sc -expand yes -fill both
74	set f [$itk_interior.sc contents frame]
75
76	set _tabs [blt::tabset $f.tabs -borderwidth 0 -relief flat \
77	-side top -tearoff 0 -samewidth 0 -highlightthickness 0 \
78	-selectbackground $itk_option(-background) \
79	-selectcommand [itcl::code $this _changeTabs -user]]
80	pack $_tabs -expand yes -fill both
81
82	set _frame [frame $_tabs.inner]
83	pack $_frame -expand yes -fill both
84
85	#
86	# Put this frame in whenever the control frame is empty.
87	# It forces the size to contract back now when controls are deleted.
88	#
89	frame $_frame.empty -width 1 -height 1
90
91	#
92	# Set up a binding that all inserted widgets will use so that
93	# we can monitor their size changes.
94	#
95	bind Controls-$this <Configure> \
96	[list $_dispatcher event -idle !resize]
97
98	eval itk_initialize $args
99	}
100
101	# ----------------------------------------------------------------------
102	# DESTRUCTOR
103	# ----------------------------------------------------------------------
104	itcl::body Rappture::Controls::destructor {} {
105	delete 0 end
106	}
107
108	# ----------------------------------------------------------------------
109	# USAGE: insert <pos> <path>
110	#
111	# Clients use this to insert a control into this panel. The control
112	# is inserted into the list at position <pos>, which can be an integer
113	# starting from 0 or the keyword "end". Information about the control
114	# is taken from the specified <path>.
115	#
116	# Returns a name that can be used to identify the control in other
117	# methods.
118	# ----------------------------------------------------------------------
119	itcl::body Rappture::Controls::insert {pos path} {
120	if {$pos ne "end" && ![string is integer $pos]} {
121	set pos [index $pos]
122	}
123
124	incr _counter
125	set name "control$_counter"
126	set path [$_owner xml element -as path $path]
127
128	set _name2info($name-path) $path
129	set _name2info($name-id) [$_owner xml element -as id $path]
130	set _name2info($name-label) ""
131	set _name2info($name-type) ""
132	set _name2info($name-value) [set w $_frame.v$name]
133	set _name2info($name-enable) "yes"
134	set _name2info($name-disablestyle) "greyout"
135
136	set type [$_owner xml element -as type $path]
137	set _name2info($name-type) $type
138	switch -- $type {
139	choice {
140	Rappture::ChoiceEntry $w $_owner $path
141	bind $w <<Value>> [itcl::code $this _controlChanged $name]
142	}
143	filechoice {
144	Rappture::FileChoiceEntry $w $_owner $path
145	bind $w <<Value>> [itcl::code $this _controlChanged $name]
146	}
147	filelist {
148	Rappture::FileListEntry $w $_owner $path
149	bind $w <<Value>> [itcl::code $this _controlChanged $name]
150	}
151	group {
152	Rappture::GroupEntry $w $_owner $path
153	}
154	loader {
155	Rappture::Loader $w $_owner $path -tool [$_owner tool]
156	bind $w <<Value>> [itcl::code $this _controlChanged $name]
157	}
158	multichoice {
159	Rappture::MultiChoiceEntry $w $_owner $path
160	bind $w <<Value>> [itcl::code $this _controlChanged $name]
161	}
162	number {
163	Rappture::NumberEntry $w $_owner $path
164	bind $w <<Value>> [itcl::code $this _controlChanged $name]
165	}
166	integer {
167	Rappture::IntegerEntry $w $_owner $path
168	bind $w <<Value>> [itcl::code $this _controlChanged $name]
169	}
170	boolean {
171	Rappture::BooleanEntry $w $_owner $path
172	bind $w <<Value>> [itcl::code $this _controlChanged $name]
173	}
174	string {
175	Rappture::TextEntry $w $_owner $path
176	bind $w <<Final>> [itcl::code $this _controlChanged $name]
177	}
178	drawing {
179	Rappture::DrawingEntry $w $_owner $path
180	}
181	image {
182	Rappture::ImageEntry $w $_owner $path
183	}
184	control {
185	set label [string trim [$_owner xml get $path.label]]
186	if {"" == $label} {
187	set label "Simulate"
188	}
189	set service [string trim [$_owner xml get $path.service]]
190	button $w -text $label -command [list $service run]
191	}
192	separator {
193	frame $w -class Separator -height 10
194	}
195	note {
196	Rappture::Note $w $_owner $path
197	}
198	periodicelement {
199	Rappture::PeriodicElementEntry $w $_owner $path
200	bind $w <<Value>> [itcl::code $this _controlChanged $name]
201	}
202	default {
203	error "don't know how to add control type \"$type\""
204	}
205	}
206
207	#
208	# If this element has an <enable> expression, then register
209	# its controlling widget here.
210	#
211	set disablestyle [string trim [$_owner xml get $path.about.disablestyle]]
212	if { $disablestyle != "" } {
213	set _name2info($name-disablestyle) $disablestyle
214	}
215	#
216	# If this element has an <enable> expression, then register
217	# its controlling widget here.
218	#
219	set enable [string trim [$_owner xml get $path.about.enable]]
220	if {"" == $enable} {
221	set enable yes
222	}
223	if {![string is boolean $enable]} {
224	set re {([a-zA-Z_]+[0-9]\|\([^\(\)]+\)\|[a-zA-Z_]+[0-9]\([^\(\)]+\))(\.([a-zA-Z_]+[0-9]\|\([^\(\)]+\)\|[a-zA-Z_]+[0-9]\([^\(\)]+\)))*(:[-a-zA-Z0-9/]+)?}
225	set rest $enable
226	set enable ""
227	set deps ""
228	while {1} {
229	if {[regexp -indices $re $rest match]} {
230	foreach {s0 s1} $match break
231
232	if {[string index $rest [expr {$s0-1}]] == "\""} {
233	# string in ""'s? then leave it alone
234	append enable [string range $rest 0 [expr {$s0-1}]]
235	set rest [string range $rest $s0 end]
236	if {[regexp -indices {[^\"]+\"} $rest match]} {
237	foreach {s0 s1} $match break
238	append enable [string range $rest $s0 $s1]
239	set rest [string range $rest [expr {$s1+1}] end]
240	} else {
241	puts stderr "WARNING: mismatched quote in enable condition for $path"
242	puts stderr " expr: [string trim [$_owner xml get $path.about.enable]]"
243	set rest ""
244	}
245	} else {
246	#
247	# This is a symbol which should be substituted
248	# it can be either:
249	# input.foo.bar
250	# input.foo.bar:units
251	#
252	set cpath [string range $rest $s0 $s1]
253	set parts [split $cpath :]
254	set ccpath [lindex $parts 0]
255	set units [lindex $parts 1]
256
257	# make sure we have the standard path notation
258	set stdpath [$_owner regularize $ccpath]
259	if {"" == $stdpath} {
260	puts stderr "WARNING: don't recognize parameter $cpath in <enable> expression for $path. This may be buried in a structure that is not yet loaded."
261	set stdpath $ccpath
262	}
263	# substitute [_controlValue ...] call in place of path
264	append enable [string range $rest 0 [expr {$s0-1}]]
265	append enable [format {[_controlValue %s %s]} $stdpath $units]
266	lappend deps $stdpath
267	set rest [string range $rest [expr {$s1+1}] end]
268	}
269	} else {
270	append enable $rest
271	break
272	}
273	}
274
275	foreach cpath $deps {
276	$_owner dependenciesfor $cpath $path
277	}
278	}
279	set _name2info($name-enable) $enable
280	$_owner widgetfor $path $w
281
282	if {[lsearch {control group drawing separator note} $type] < 0} {
283	# make a label for this control
284	set label [$w label]
285	if {$label ne ""} {
286	set _name2info($name-label) $_frame.l$name
287	set font [option get $itk_component(hull) labelFont Font]
288	label $_name2info($name-label) -text [_formatLabel $label] \
289	-font $font
290	}
291
292	# register the tooltip for this control
293	set tip [$w tooltip]
294	if {$tip ne ""} {
295	Rappture::Tooltip::for $w $tip -log $path
296
297	# add the tooltip to the label too, if there is one
298	if {$_name2info($name-label) ne ""} {
299	Rappture::Tooltip::for $_name2info($name-label) $tip -log $path
300	}
301	}
302	}
303
304	# insert the new control onto the known list
305	set _controls [linsert $_controls $pos $name]
306	_monitor $name on
307
308	# now that we have a new control, we should fix the layout
309	$_dispatcher event -idle !layout
310	_controlChanged $name
311
312	return $name
313	}
314
315	# ----------------------------------------------------------------------
316	# USAGE: delete <first> ?<last>?
317	#
318	# Clients use this to delete one or more controls from this widget.
319	# The <first> and <last> represent the integer index of the desired
320	# control. You can use the "index" method to convert a control name to
321	# its integer index. If only <first> is specified, then that one
322	# control is deleted. If <last> is specified, then all controls in the
323	# range <first> to <last> are deleted.
324	# ----------------------------------------------------------------------
325	itcl::body Rappture::Controls::delete {first {last ""}} {
326	if {$last == ""} {
327	set last $first
328	}
329	if {![string is integer $first]} {
330	set first [index $first]
331	}
332	if {![string is integer $last]} {
333	set last [index $last]
334	}
335
336	foreach name [lrange $_controls $first $last] {
337	_monitor $name off
338
339	if {"" != $_name2info($name-label)} {
340	destroy $_name2info($name-label)
341	}
342	if {"" != $_name2info($name-value)} {
343	destroy $_name2info($name-value)
344	}
345	$_owner widgetfor $_name2info($name-path) ""
346	array unset _name2info $name-*
347	}
348	set _controls [lreplace $_controls $first $last]
349
350	$_dispatcher event -idle !layout
351	}
352
353	# ----------------------------------------------------------------------
354	# USAGE: index <name>\|<path>\|@n\|end
355	#
356	# Clients use this to convert a control <name> into its corresponding
357	# integer index. Returns an error if the <name> is not recognized.
358	# ----------------------------------------------------------------------
359	itcl::body Rappture::Controls::index {val} {
360	set i [lsearch $_controls $val]
361	if {$i >= 0} {
362	return $i
363	}
364	if {[regexp {^@([0-9]+)$} $val match i]} {
365	return $i
366	}
367	if {$val eq "end"} {
368	return [expr {[llength $_controls]-1}]
369	}
370
371	# treat as a path name and search for this path
372	foreach name $_controls {
373	if {$_name2info($name-path) eq $val} {
374	set i [lsearch $_controls $name]
375	if {$i >= 0} {
376	return $i
377	}
378	}
379	}
380
381	error "bad control name \"$name\": should be @int or \"end\" or path name or one of [join [lsort $_controls] {, }]"
382	}
383
384	# ----------------------------------------------------------------------
385	# USAGE: control ?-label\|-value\|-path\|-enable? ?<name>\|@n?
386	#
387	# Clients use this to get information about controls. With no args, it
388	# returns a list of all control names. Otherwise, it returns the frame
389	# associated with a control name. The -label option requests the label
390	# widget instead of the value widget. The -path option requests the
391	# path within the XML that the control affects. The -enable option
392	# requests the enabling condition for this control.
393	# ----------------------------------------------------------------------
394	itcl::body Rappture::Controls::control {args} {
395	if {[llength $args] == 0} {
396	return $_controls
397	}
398	Rappture::getopts args params {
399	flag switch -value default
400	flag switch -label
401	flag switch -path
402	flag switch -enable
403	flag switch -disablestyle
404	}
405	if {[llength $args] == 0} {
406	error "missing control name"
407	}
408	set i [index [lindex $args 0]]
409	set name [lindex $_controls $i]
410
411	set opt $params(switch)
412	return $_name2info($name$opt)
413	}
414
415	# ----------------------------------------------------------------------
416	# USAGE: refresh
417	#
418	# Clients use this to refresh the layout of the control panel
419	# whenever a widget within the panel changes visibility state.
420	# ----------------------------------------------------------------------
421	itcl::body Rappture::Controls::refresh {} {
422	$_dispatcher event -idle !layout
423	}
424
425	# ----------------------------------------------------------------------
426	# USAGE: _layout
427	#
428	# Used internally to fix the layout of controls whenever controls
429	# are added or deleted, or when the control arrangement changes.
430	# There are a lot of heuristics here trying to achieve a "good"
431	# arrangement of controls.
432	# ----------------------------------------------------------------------
433	itcl::body Rappture::Controls::_layout {} {
434	#
435	# Clear any existing layout
436	#
437	foreach {rmax cmax} [grid size $_frame] break
438	for {set r 0} {$r < $rmax} {incr r} {
439	grid rowconfigure $_frame $r -weight 0 -minsize 0
440	}
441	grid rowconfigure $_frame 99 -weight 0
442
443	for {set c 0} {$c < $cmax} {incr c} {
444	grid columnconfigure $_frame $c -weight 0 -minsize 0
445	}
446
447	foreach name $_controls {
448	foreach elem {label value} {
449	set w $_name2info($name-$elem)
450	if {$w ne "" && [winfo exists $w]} {
451	grid forget $w
452	}
453	}
454	}
455	grid forget $_frame.empty
456
457	if {[$_tabs size] > 0} {
458	$_tabs delete 0 end
459	}
460
461	#
462	# Decide which widgets should be shown and which should be hidden.
463	#
464	set hidden ""
465	set showing ""
466	foreach name $_controls {
467	set show 1
468	set cond $_name2info($name-enable)
469	if {[string is boolean $cond] && !$cond} {
470	# hard-coded "off" -- ignore completely
471
472	# When the "enable" of a control is hardcoded "off", "0", etc., it
473	# means to hide the control. This is used by bandstrlab to add
474	# invisible parameters to a structure. The value of the parameter
475	# is used by other widgets with enable statements.
476
477	# The proper method for doing this is to add a
478	# <disablestyle>hide<disablestyle>
479	# tag to the about section of the control.
480
481	} elseif {[catch {expr $cond} show] == 0} {
482	set type $_name2info($name-type)
483	set disablestyle $_name2info($name-disablestyle)
484	set lwidget $_name2info($name-label)
485	set vwidget $_name2info($name-value)
486	if {[lsearch -exact {group image structure} $type] >= 0 \|\|
487	$disablestyle == "hide" } {
488	if {$show ne "" && $show} {
489	lappend showing $name
490	} else {
491	lappend hidden $name
492	}
493	} else {
494	# show other objects, but enable/disable them
495	lappend showing $name
496	if {$show ne "" && $show} {
497	catch {$vwidget configure -state normal}
498	if {[winfo exists $lwidget]} {
499	$lwidget configure -foreground \
500	[lindex [$lwidget configure -foreground] 3]
501	}
502	} else {
503	catch {$vwidget configure -state disabled}
504	if {[winfo exists $lwidget]} {
505	$lwidget configure -foreground gray
506	}
507	}
508	}
509	} else {
510	bgerror "Error in <enable> expression for \"$_name2info($name-path)\":\n $show"
511	}
512	}
513
514	# store the showing tabs in the object so it can be used in _changeTabs
515	set _showing $showing
516
517	#
518	# Decide on a layout scheme:
519	# default ...... tabs for groups of groups; vertical otherwise
520	# tabs ......... tabbed notebook
521	# vertical ..... "label: value" down in rows
522	# horizontal ... "label: value" across columns
523	# sentence ..... text with embedded widgets
524	#
525	set _scheme $itk_option(-layout)
526	if {$_scheme eq "" \|\| $_scheme eq "tabs"} {
527	if {[llength $showing] < 2} {
528	set _scheme "vertical"
529	} else {
530	set _scheme "tabs"
531	foreach name $showing {
532	set w $_name2info($name-value)
533	if {[winfo class $w] ne "GroupEntry"} {
534	# something other than a group? then fall back on vertical
535	set _scheme "vertical"
536	break
537	}
538	}
539	}
540	}
541
542	# if the layout is "sentence:..." then create new parts
543	if {[string match {sentence:*} $itk_option(-layout)]
544	&& [array size _sentenceparts] == 0} {
545	set n 0
546	set font [option get $itk_component(hull) labelFont Font]
547	set str [string range $itk_option(-layout) 9 end]
548	while {[regexp -indices {\$\{([a-zA-Z0-9_]+)\}} $str match name]} {
549	foreach {s0 s1} $name break
550	set name [string range $str $s0 $s1]
551
552	# create a label for the string before the substitution
553	foreach {s0 s1} $match break
554	set prefix [string trim [string range $str 0 [expr {$s0-1}]]]
555	if {$prefix ne ""} {
556	set lname $_frame.sentence[incr n]
557	label $lname -text $prefix -font $font
558	lappend _sentenceparts(all) $lname
559	lappend _sentenceparts(fragments) $lname
560	}
561
562	# add the widget for the substitution part
563	set found ""
564	foreach c $_controls {
565	if {$_name2info($c-id) eq $name} {
566	set found $c
567	break
568	}
569	}
570	if {$found ne ""} {
571	lappend _sentenceparts(all) $_name2info($found-value)
572	} else {
573	puts stderr "WARNING: name \"$name\" in sentence layout \"$itk_option(-layout)\" not recognized"
574	}
575
576	set str [string range $str [expr {$s1+1}] end]
577	}
578
579	# create a label for any trailing string
580	set str [string trim $str]
581	if {$str ne ""} {
582	set lname $_frame.sentence[incr n]
583	label $lname -text $str -font $font
584	lappend _sentenceparts(all) $lname
585	lappend _sentenceparts(fragments) $lname
586	}
587	}
588
589	switch -glob -- $_scheme {
590	tabs {
591	#
592	# SCHEME: tabs
593	# put a series of groups into a tabbed notebook
594	#
595
596	# stop covering up the tabset and put the _frame inside the tabs
597	pack forget $_frame
598	$_tabs configure -width 0 -height 0
599
600	set gn 1
601	foreach name $showing {
602	set wv $_name2info($name-value)
603	$wv configure -heading no
604	set label [$wv component heading cget -text]
605	if {"" == $label} {
606	set label "Group #$gn"
607	}
608	set _name2info($name-label) $label
609	$_tabs insert end $name -text $label \
610	-activebackground $itk_option(-background) \
611	-window $_frame -fill both
612	incr gn
613	}
614
615	# compute the overall size
616	# BE CAREFUL: do this after setting "-heading no" above
617	$_dispatcher event -now !resize
618
619	grid columnconfigure $_frame 0 -weight 1
620	grid rowconfigure $_frame 0 -weight 1
621
622	$_tabs select 0; _changeTabs
623	}
624
625	vertical {
626	#
627	# SCHEME: vertical
628	# simple "Label: Value" layout
629	#
630	if {[$_tabs size] > 0} {
631	$_tabs delete 0 end
632	}
633	pack $_frame -expand yes -fill both
634	$_tabs configure -width [winfo reqwidth $_frame] \
635	-height [winfo reqheight $_frame]
636
637	set expand 0 ;# most controls float to top
638	set row 0
639	foreach name $showing {
640	set wl $_name2info($name-label)
641	if {$wl != "" && [winfo exists $wl]} {
642	grid $wl -row $row -column 0 -sticky e
643	}
644
645	set wv $_name2info($name-value)
646	if {$wv ne "" && [winfo exists $wv]} {
647	if {$wl != ""} {
648	grid $wv -row $row -column 1 -sticky ew
649	} else {
650	grid $wv -row $row -column 0 -columnspan 2 -sticky ew
651	}
652
653	grid rowconfigure $_frame $row -weight 0
654
655	switch -- [winfo class $wv] {
656	TextEntry {
657	if {[regexp {[0-9]+x[0-9]+} [$wv size]]} {
658	grid $wl -sticky ne -pady 4
659	grid $wv -sticky nsew
660	grid rowconfigure $_frame $row -weight 1
661	grid columnconfigure $_frame 1 -weight 1
662	set expand 1
663	}
664	}
665	GroupEntry {
666	$wv configure -heading yes
667
668	#
669	# Scan through all children in this group
670	# and see if any demand more space. If the
671	# group contains a structure or a note, then
672	# make sure that the group itself is set to
673	# expand/fill.
674	#
675	set queue [winfo children $wv]
676	set expandgroup 0
677	while {[llength $queue] > 0} {
678	set w [lindex $queue 0]
679	set queue [lrange $queue 1 end]
680	set c [winfo class $w]
681	if {[lsearch {DeviceEditor Note} $c] >= 0} {
682	set expandgroup 1
683	break
684	}
685	eval lappend queue [winfo children $w]
686	}
687	if {$expandgroup} {
688	set expand 1
689	grid $wv -sticky nsew
690	grid rowconfigure $_frame $row -weight 1
691	}
692	}
693	Note {
694	grid $wv -sticky nsew
695	grid rowconfigure $_frame $row -weight 1
696	set expand 1
697	}
698	}
699	grid columnconfigure $_frame 1 -weight 1
700	}
701
702	incr row
703	grid rowconfigure $_frame $row -minsize $itk_option(-padding)
704	incr row
705	}
706	grid $_frame.empty -row $row
707
708	#
709	# If there are any hidden items, then make the bottom of
710	# this form fill up any extra space, so the form floats
711	# to the top. Otherwise, it will jitter around as the
712	# hidden items come and go.
713	#
714	if {[llength $hidden] > 0 && !$expand} {
715	grid rowconfigure $_frame 99 -weight 1
716	} else {
717	grid rowconfigure $_frame 99 -weight 0
718	}
719	}
720
721	horizontal {
722	#
723	# SCHEME: horizontal
724	# lay out left to right
725	#
726	if {[$_tabs size] > 0} {
727	$_tabs delete 0 end
728	}
729	pack $_frame -expand yes -fill both
730	$_tabs configure -width [winfo reqwidth $_frame] \
731	-height [winfo reqheight $_frame]
732
733	set col 0
734	set pad [expr {$itk_option(-padding)/2}]
735	foreach name $showing {
736	set wl $_name2info($name-label)
737	if {$wl != "" && [winfo exists $wl]} {
738	grid $wl -row 0 -column $col -sticky e -padx $pad
739	incr col
740	}
741
742	set wv $_name2info($name-value)
743	if {$wv != "" && [winfo exists $wv]} {
744	grid $wv -row 0 -column $col -sticky ew -padx $pad
745	grid columnconfigure $_frame $col -weight 0
746	incr col
747	}
748	}
749	}
750
751	sentence:* {
752	#
753	# SCHEME: sentence
754	# lay out left to right with sentence parts: "( [x] , [y] )"
755	#
756	if {[$_tabs size] > 0} {
757	$_tabs delete 0 end
758	}
759	pack $_frame -expand yes -fill both
760	$_tabs configure -width [winfo reqwidth $_frame] \
761	-height [winfo reqheight $_frame]
762
763	set col 0
764	set pad [expr {$itk_option(-padding)/2}]
765	foreach widget $_sentenceparts(all) {
766	grid $widget -row 0 -column $col -padx $pad
767	incr col
768	}
769	}
770	}
771	}
772
773	# ----------------------------------------------------------------------
774	# USAGE: _monitor <name> <state>
775	#
776	# Used internally to add/remove bindings that cause the widget
777	# associated with <name> to notify this controls widget of size
778	# changes. Whenever there is a size change, this controls widget
779	# should fix its layout.
780	# ----------------------------------------------------------------------
781	itcl::body Rappture::Controls::_monitor {name state} {
782	set tag "Controls-$this"
783	set wv $_name2info($name-value)
784	if {[catch {bindtags $wv} btags]} {
785	return
786	}
787	set i [lsearch $btags $tag]
788
789	if {$state} {
790	if {$i < 0} {
791	bindtags $wv [linsert $btags 0 $tag]
792	}
793	} else {
794	if {$i >= 0} {
795	bindtags $wv [lreplace $btags $i $i]
796	}
797	}
798	}
799
800	# ----------------------------------------------------------------------
801	# USAGE: _controlChanged <name>
802	#
803	# Invoked automatically whenever the value for a control changes.
804	# Sends a notification along to the tool controlling this panel.
805	# ----------------------------------------------------------------------
806	itcl::body Rappture::Controls::_controlChanged {name} {
807	set path $_name2info($name-path)
808
809	#
810	# Let the owner know that this control changed.
811	#
812	if {"" != $_owner} {
813	$_owner changed $path
814	}
815	}
816
817	# ----------------------------------------------------------------------
818	# USAGE: _controlValue <path> ?<units>?
819	#
820	# Used internally to get the value of a control with the specified
821	# <path>. Returns the current value for the control.
822	# ----------------------------------------------------------------------
823	itcl::body Rappture::Controls::_controlValue {path {units ""}} {
824	if {"" != $_owner} {
825	set val [$_owner valuefor $path]
826	if {"" != $units} {
827	set val [Rappture::Units::convert $val -to $units -units off]
828	}
829	return $val
830	}
831	return ""
832	}
833
834	# ----------------------------------------------------------------------
835	# USAGE: _formatLabel <string>
836	#
837	# Used internally to format a label <string>. Trims any excess
838	# white space and adds a ":" to the end. That way, all labels
839	# have a uniform look.
840	# ----------------------------------------------------------------------
841	itcl::body Rappture::Controls::_formatLabel {str} {
842	set str [string trim $str]
843	if {"" != $str && [string index $str end] != ":"} {
844	append str ":"
845	}
846	return $str
847	}
848
849	# ----------------------------------------------------------------------
850	# USAGE: _changeTabs ?-user\|-program?
851	#
852	# Used internally to change tabs when the user clicks on a tab
853	# in the "tabs" layout mode. This mode is used when the widget
854	# contains nothing but groups, as a compact way of representing
855	# the groups.
856	# ----------------------------------------------------------------------
857	itcl::body Rappture::Controls::_changeTabs {{why -program}} {
858	set i [$_tabs index select]
859	# we use _showing here instead of _controls because sometimes tabs
860	# are disabled, and the index of the choosen tab always matches
861	# _showing, even if tabs are disabled.
862	set name [lindex $_showing $i]
863	if {$name ne ""} {
864	foreach w [grid slaves $_frame] {
865	grid forget $w
866	}
867
868	set wv $_name2info($name-value)
869	grid $wv -row 0 -column 0 -sticky nsew
870
871	$_tabs tab configure [$_tabs get $i] -window $_frame
872
873	if {$why eq "-user"} {
874	Rappture::Logger::log group $_name2info($name-path)
875	}
876	}
877	}
878
879	# ----------------------------------------------------------------------
880	# USAGE: _resize
881	#
882	# Used internally to resize the widget when its contents change.
883	# ----------------------------------------------------------------------
884	itcl::body Rappture::Controls::_resize {} {
885	switch -glob -- $_scheme {
886	tabs {
887	# in "tabs" mode, the overall size is the largest for all pages
888	set maxw 0
889	set maxh 0
890	update idletasks
891	foreach name $_controls {
892	set wv $_name2info($name-value)
893	set w [winfo reqwidth $wv]
894	if {$w > $maxw} { set maxw $w }
895	set h [winfo reqheight $wv]
896	if {$h > $maxh} { set maxh $h }
897	}
898
899	# Turn off propagation temporarily so that we don't keep
900	# recursing back into this routine when we change the frame's
901	# dimensions below.
902	grid propagate $_frame no
903
904	$_frame configure -width $maxw -height $maxh
905
906	# Turn progagation back on so that the parent widget recognizes
907	# when the widget changes size or is unpacked.
908	grid propagate $_frame yes
909	}
910	vertical - horizontal - sentence* {
911	# in other modes, just use normal size propagation
912	grid propagate $_frame yes
913	}
914	default {
915	error "bad layout scheme \"$_scheme\""
916	}
917	}
918	}
919
920	# ----------------------------------------------------------------------
921	# OPTION: -padding
922	# ----------------------------------------------------------------------
923	itcl::configbody Rappture::Controls::padding {
924	$_dispatcher event -idle !layout
925	}
926
927	# ----------------------------------------------------------------------
928	# OPTION: -layout
929	# ----------------------------------------------------------------------
930	itcl::configbody Rappture::Controls::layout {
931	# clear any existing sentence parts
932	if {[array size _sentenceparts] > 0} {
933	foreach part $_sentenceparts(fragments) {
934	destroy $part
935	}
936	catch {unset _sentenceparts}
937	}
938
939	if {![regexp {^(\|horizontal\|vertical\|tabs\|sentence:.+)$} $itk_option(-layout)]} {
940	puts "ERROR: bad layout option \"$itk_option(-layout)\" -- should be horizontal, vertical, tabs or sentence:..."
941	set itk_option(-layout) ""
942	}
943
944	# recompute the layout at some point
945	$_dispatcher event -idle !layout
946	}

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

Download in other formats: