Context Navigation

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

Last change on this file since 1929 was 1929, checked in by gah, 14 years ago

File size: 25.7 KB

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

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

Download in other formats: