Context Navigation

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

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

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

Download in other formats: