Context Navigation

controls.tcl @ 3186

Last change on this file since 3186 was 3186, checked in by mmc, 12 years ago

Added the Rappture::Logger facility and updated many (not all)
of the input/output controls to use it. This logs user activity
so you can see how they are interacting with the widgets during
the course of a session. If the RAPPTURE_LOG variable is set to
a directory (like /tmp), then Rappture creates a unique log file
in this directory for each tool session and writes logging info
into that file. The middleware ensures that the file is write-only
so that private activity information doesn't get out to people who
try to snoop around.

File size: 26.9 KB

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

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

Context Navigation

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

Download in other formats: