Context Navigation

source: branches/blt4/gui/scripts/controls.tcl @ 1695

Last change on this file since 1695 was 1677, checked in by gah, 15 years ago

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

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

Download in other formats: