Context Navigation

source: trunk/gui/scripts/controls.tcl @ 4735

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

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

Download in other formats: