Context Navigation

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

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

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

Download in other formats: