Context Navigation

source: trunk/builder/scripts/main.tcl @ 3989

Last change on this file since 3989 was 3989, checked in by gah, 11 years ago
fix typo in AdjustSettings? for vtkvolumeviewer
File size: 56.7 KB

Line
1	# ----------------------------------------------------------------------
2	# USER INTERFACE BUILDER
3	#
4	# This program allows the user to create a tool.xml file, or reload
5	# and edit an existing tool.xml. It also produces some skeleton
6	# code for the main program that queries inputs and saves outputs.
7	#
8	# RUN AS FOLLOWS:
9	# wish main.tcl ?-tool <toolfile>?
10	#
11	# If the <toolfile> is not specified, it defaults to "tool.xml" in
12	# the current working directory.
13	#
14	# ======================================================================
15	# AUTHOR: Michael McLennan, Purdue University
16	# Copyright (c) 2004-2012 HUBzero Foundation, LLC
17	#
18	# See the file "license.terms" for information on usage and
19	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
20	# ======================================================================
21
22	# take the main window down for now, so we can avoid a flash on the screen
23	wm withdraw .
24
25	package require Itcl
26	package require Rappture
27	package require RapptureGUI
28	package require Img
29
30	option add *Tooltip.background white
31	option add *Editor.background white
32	option add *Gauge.textBackground white
33	option add *TemperatureGauge.textBackground white
34	option add *Switch.textBackground white
35	option add *Progress.barColor #ffffcc
36	option add *Balloon.titleBackground #6666cc
37	option add *Balloon.titleForeground white
38	option add BalloonLabel.font --helvetica-medium-r-normal--12-*
39	option add BalloonRadiobutton.font --helvetica-medium-r-normal--12-*
40	option add BalloonCheckbutton.font --helvetica-medium-r-normal--12-*
41	option add BugReportbanner*foreground white
42	option add BugReportbanner*background #a9a9a9
43	option add BugReportbanner*highlightBackground #a9a9a9
44	option add BugReportbannerfont --helvetica-bold-r-normal--18-
45	option add *Filmstrip.background #aaaaaa
46	option add *Hierlist.selectBackground #9999ff
47	option add *errorHighlightColor #9999ff
48	option add *previewButtonBackground #4a758c
49	option add *previewButtonActiveBackground #a3c3cc
50	option add *previewButtonForeground white
51	option add *previewButtonIcon arrow-up-white
52	option add buildcntls*background #cccccc
53	option add buildcntls*highlightBackground #cccccc
54	option add buildcntls*font {helvetica -12}
55	option add buildcntls*Button.borderWidth 1
56	option add buildcntls*Button.relief flat
57	option add buildcntls*Button.overRelief raised
58	option add buildcntls*Button.padX 2
59	option add buildcntls*Editor.background white
60	option add buildeditelem*background #cccccc
61	option add buildeditelem*font {helvetica -12}
62	option add buildeditelem*title.font {helvetica -12 italic}
63	option add buildeditelem*vopt.font {helvetica -12 italic}
64	option add optionsEntry.background white
65	option add optionsListbox.background white
66	option add optionsText.background white
67	option add optionsText.font {Helvetica -12}
68	option add optionsButton.font {Helvetica -10}
69	option add optionsButton.padX 2
70	option add optionsButton.padY 2
71	option add options.errsBackground black
72	option add options.errshighlightBackground black
73	option add options.errsForeground white
74	option add options.errsButton.relief flat
75	option add options.errsButton.padX 1
76	option add options.errsButton.padY 1
77	option add saveastoolv*Label.font {Helvetica -12}
78	option add saveastoolv*Button.font {Helvetica -12}
79	option add saveastoolv*Button.borderWidth 1
80	option add saveastoolv*Button.padX 2
81	option add saveastoolv*Button.padY 2
82	option add saveasprogv*Label.font {Helvetica -12}
83	option add saveasprogv*Button.font {Helvetica -12}
84	option add saveasprogv*Button.borderWidth 1
85	option add saveasprogv*Button.padX 2
86	option add saveasprogv*Button.padY 2
87
88	switch $tcl_platform(platform) {
89	unix {
90	event add <<PopupMenu>> <ButtonPress-3>
91
92	# make Ctrl-V binding work:
93	# not strict Motif, and remove conflicting binding in Tk library
94	set tk_strictMotif 0
95	bind Text <Control-v> ""
96	}
97	windows {
98	event add <<PopupMenu>> <ButtonPress-3>
99	}
100	macintosh {
101	event add <<PopupMenu>> <Control-ButtonPress-1>
102	}
103	}
104
105	wm protocol . WM_DELETE_WINDOW main_exit
106	wm title . "Rappture Builder"
107
108	# install a better bug handler
109	Rappture::bugreport::install
110	# fix the "grab" command to support a stack of grab windows
111	Rappture::grab::init
112
113	#
114	# Process command line args to get the names of files to load...
115	#
116	Rappture::getopts argv params {
117	value -tool ""
118	}
119
120	# load type and object definitions
121	set dir [file dirname [info script]]
122	set auto_path [linsert $auto_path 0 $dir]
123
124	Rappture::icon foo ;# force loading of this module
125	lappend Rappture::icon::iconpath [file join $dir images]
126
127	# automatically load all Rappture object types
128	if {[catch {Rappture::objects::init} err]} {
129	puts stderr "Error loading object definitions:\n$err"
130	exit 1
131	}
132	if {[catch {Rappture::objects::load [file join $dir tool.rp]} err]} {
133	puts stderr "Error loading tool object definition:\n$err"
134	exit 1
135	}
136
137	# load all languages recognized by the builder
138	RapptureBuilder::templates::init
139
140	# ----------------------------------------------------------------------
141	# HACK ALERT! Make it so the Analyzer can't possibly enable its
142	# simulate button in "preview" mode, or else the user might
143	# actually launch a simulation.
144	# ----------------------------------------------------------------------
145	itcl::body Rappture::Analyzer::_simState {state args} {
146	if {"" != $itk_option(-simcontrolbackground)} {
147	set simcbg $itk_option(-simcontrolbackground)
148	} else {
149	set simcbg $itk_option(-background)
150	}
151	$itk_interior.simol configure \
152	-background $itk_option(-simcontroloutline)
153	configure -simcontrolcolor $simcbg
154
155	$itk_component(simulate) configure -state disabled
156	}
157
158	# ----------------------------------------------------------------------
159	# USAGE: main_palette_source <type>
160	#
161	# Returns drag-n-drop data for the object <type>. This data can be
162	# dragged between the filmstrip object palettes and the hierlist of
163	# nodes for the current tool.
164	# ----------------------------------------------------------------------
165	set ValueId 0
166	proc main_palette_source {type} {
167	global ValueId
168	if {[catch {Rappture::objects::get $type -attributes} attrs]} {
169	return ""
170	}
171	set term [Rappture::objects::get $type -terminal]
172	set vname "value[incr ValueId]"
173	set type [string totitle $type]
174	return [list node: id $vname type $type terminal $term \
175	attributes [list label $type]]
176	}
177
178	# ----------------------------------------------------------------------
179	# USAGE: main_open ?-new\|-file\|filename?
180	#
181	# Handles the Open... operation, which opens a tool.xml file and
182	# loads the contents. If there are any pending changes, the user
183	# is prompted to save the changes before continuing with the open.
184	# ----------------------------------------------------------------------
185	proc main_open {{what "-new"}} {
186	global ToolXml LastToolXmlFile LastToolXmlLoaded ValueId
187
188	if {![main_options_save -clear]} {
189	return
190	}
191	set win [.func.build.options.panes pane 0]
192	$win.scrl.skel select none
193
194	main_generate_xml
195
196	if {[string length $LastToolXmlLoaded] > 0 && [$ToolXml xml] ne $LastToolXmlLoaded} {
197	set choice [tk_messageBox -icon warning -type yesno -title "Rappture: Save Changes?" -message "Changes to the current tool haven't been saved.\n\nSave changes?"]
198	if {$choice == "yes" && ![main_saveas]} {
199	return
200	}
201	}
202
203	if {$what == "-new"} {
204	set xmlobj [Rappture::LibraryObj ::#auto "<?xml version=\"1.0\"?><run><tool/></run>"]
205	} else {
206	if {$what == "-file"} {
207	set fname [tk_getOpenFile -title "Rappture: Open Tool" -initialfile "tool.xml" -defaultextension .xml -filetypes { {{XML files} .xml} {{All files} *} }]
208	} else {
209	set fname $what
210	}
211
212	if {"" == $fname} {
213	return
214	}
215
216	# save the current file name in the "Save As..." dialog for later
217	set LastToolXmlFile $fname
218	.saveas.opts.toolv.file configure -text $fname
219	main_saveas update
220
221	if {[catch {Rappture::library $fname} xmlobj]} {
222	tk_messageBox -icon error -title "Rappture: Error" -message "Error loading tool description: $xmlobj"
223	return
224	}
225	}
226
227	# plug in the new tool definition
228	set LastToolXmlLoaded [$xmlobj xml]
229	set ValueId 0
230
231	# clear the tree and load the new data
232	set win [.func.build.options.panes pane 0]
233	$win.scrl.skel tree delete all
234	pack forget .func.build.options.errs
235
236	set alist [main_open_import_attrs $xmlobj tool]
237	$win.scrl.skel tree insert 0 end \
238	type "Tool" terminal yes dragdrop no attributes $alist
239
240	# all the Input section
241	set n [$win.scrl.skel tree insert 0 end \
242	type "Input" terminal no dragdrop no]
243	main_open_children $win.scrl.skel $xmlobj $n
244
245	# all the Output section
246	set n [$win.scrl.skel tree insert 0 end \
247	type "Output" terminal no dragdrop no]
248	main_open_children $win.scrl.skel $xmlobj $n
249	}
250
251	# ----------------------------------------------------------------------
252	# USAGE: main_open_children <hierlist> <xmlobj> <node>
253	#
254	# Called by main_open to insert children in the <xml> at the specified
255	# <node> into the given <hierlist> widget. The children must be
256	# recognized object types.
257	# ----------------------------------------------------------------------
258	proc main_open_children {hierlist xmlobj node} {
259	global ValueId
260
261	set path [$hierlist tree path $node "%lc:type(%id)"]
262	regsub -all {\(%id\)} $path "" path
263
264	foreach elem [$xmlobj children $path] {
265	set type [$xmlobj element -as type $path.$elem]
266
267	# make sure that this is a recognized object type
268	if {[catch {Rappture::objects::get $type -image} result] == 0
269	&& [string length $result] > 0} {
270
271	# get info about this object
272	set id [$xmlobj element -as id $path.$elem]
273	set term [Rappture::objects::get $type -terminal]
274	set alist [main_open_import_attrs $xmlobj $path.$elem]
275
276	# add it into the tree
277	set newnode [$hierlist tree insert $node end \
278	type [string totitle $type] id $id terminal $term \
279	attributes $alist]
280
281	# find the highest auto-generated node and start from there
282	if {[regexp {^value([0-9]+)$} $id match num]} {
283	if {$num > $ValueId} {
284	set ValueId $num
285	}
286	}
287
288	if {!$term} {
289	# if it can have children, then add any children
290	main_open_children $hierlist $xmlobj $newnode
291	}
292	}
293	}
294	}
295
296	# ----------------------------------------------------------------------
297	# USAGE: main_open_import_attrs <xml> <path>
298	#
299	# Called by main_open_children to import attributes from the place
300	# <path> in the <xml> object.
301	# ----------------------------------------------------------------------
302	proc main_open_import_attrs {xmlobj path} {
303	set alist ""
304	set type [$xmlobj element -as type $path]
305	set side [lindex [split $path .] 0]
306
307	if {[catch {Rappture::objects::get $type -attributes} attr] == 0} {
308	# scan through and ingest all known attributes
309	foreach rec $attr {
310	set name [lindex $rec 0]
311	catch {unset info}
312	array set info [lrange $rec 1 end]
313
314	# see if this attribute is excluded based on the -only option
315	if {$info(-only) ne "" && [lsearch $info(-only) $side] < 0} {
316	continue ;# skip it!
317	}
318
319	set atype [lindex [split $info(-type) :] 0]
320	set proc "Attr[string totitle $atype]::import"
321	if {[catch {$proc $xmlobj $path.$info(-path)} result]} {
322	puts "ERROR: $result"
323	puts " skipping $name attribute of $path"
324	} else {
325	lappend alist $name $result
326	}
327	}
328	}
329	return $alist
330	}
331
332	# ----------------------------------------------------------------------
333	# USAGE: main_errors ?-strict?
334	#
335	# Checks the values of all objects in the tree to look for errors
336	# before previewing and saving. If any errors are found and the
337	# -strict flag is set, the user is forced to look at them before
338	# continuing on. Otherwise, the user may choose to look at warnings
339	# and errors before continuing. Usually called before previewing
340	# and saving the tool definition. Returns 1 if there are errors that
341	# should be viewed/fixed, and 0 otherwise.
342	# ----------------------------------------------------------------------
343	proc main_errors {args} {
344	global ErrList ErrListPos
345
346	set strict no
347	while {[llength $args] > 0} {
348	set flag [lindex $args 0]
349	set args [lrange $args 1 end]
350	if {$flag eq "-strict"} {
351	set strict yes
352	} else {
353	error "bad option \"$flag\": should be -strict"
354	}
355	}
356
357	set ErrList ""
358	set ErrListPos 0
359	set ErrFocusAttr ""
360	pack forget .func.build.options.errs
361
362	set counter 0
363	set win [.func.build.options.panes pane 0]
364	set hlist $win.scrl.skel
365	set nodelist [$hlist tree children 0]
366	while {[llength $nodelist] > 0} {
367	set node [lindex $nodelist 0]
368	set nodelist [lrange $nodelist 1 end]
369
370	# add children into the node traversal list
371	set cnodes [$hlist tree children $node]
372	if {[llength $cnodes] > 0} {
373	set nodelist [eval linsert [list $nodelist] 0 $cnodes]
374	}
375
376	set type [string tolower [$hlist tree get $node type]]
377
378	# make sure this object has a viewer
379	if {[catch {Rappture::objects::get $type -palettes} pals]} {
380	# must not have an object definition
381	continue
382	}
383	set debug [list -node $node -counter [incr counter]]
384
385	set path [$hlist tree path $node "%lc:type(%id)"]
386	regsub -all {\(%id\)} $path "" path
387	# convert input.foo to palette name "Inputs"
388	set side [lindex [split $path .] 0]
389	set pname "[string totitle $side]s"
390
391	if {$side ne "tool" && [lsearch $pals $pname] < 0} {
392	lappend ErrList [list error "This object doesn't yet have a visualizer that lets it be used as an $side to the program. Support for this probably will be added in a future version of Rappture, but for now, it must be removed from the $side section." $debug]
393	continue
394	}
395
396	# query attributes for this type and check their values
397	if {[catch {Rappture::objects::get $type -attributes} attrdef]
398	\|\| [catch {$hlist tree get $node attributes} attrlist]} {
399	# can't find any attributes for this node or node type
400	continue
401	}
402	array set ainfo $attrlist
403
404	foreach rec $attrdef {
405	set name [lindex $rec 0]
406	if {![info exists ainfo($name)]} {
407	set ainfo($name) ""
408	}
409	}
410
411	# perform all checks for this attribute type and append to ErrList
412	eval lappend ErrList [Rappture::objects::check $type \
413	$side [array get ainfo] $debug]
414	}
415
416	if {[llength $ErrList] > 0} {
417	# arrange errors in order of severity
418	set ErrList [lsort -decreasing -command main_errors_cmp $ErrList]
419
420	# count the errors and warnings
421	set nerrs 0
422	set nwarn 0
423	set nother 0
424	foreach rec $ErrList {
425	switch -- [lindex $rec 0] {
426	error { incr nerrs }
427	warning { incr nwarn }
428	default { incr nother }
429	}
430	}
431
432	set phrases ""
433	if {$nerrs == 1} {
434	lappend phrases "1 error"
435	} elseif {$nerrs > 1} {
436	lappend phrases "$nerrs errors"
437	}
438	if {$nwarn == 1} {
439	lappend phrases "1 warning"
440	} elseif {$nwarn > 1} {
441	lappend phrases "$nwarn warnings"
442	}
443	if {$nother == 1} {
444	lappend phrases "1 other suggestion"
445	} elseif {$nother > 1} {
446	lappend phrases "$nother suggestions"
447	}
448	switch -- [llength $phrases] {
449	1 { set phrases [lindex $phrases 0] }
450	2 { set phrases [join $phrases " and "] }
451	3 { set phrases [join $phrases "%"]
452	regsub "%" $phrases ", " phrases
453	regsub "%" $phrases ", and " phrases
454	}
455	}
456
457	if {$nerrs+$nwarn+$nother == 1} {
458	set thereis "There is"
459	set problem "this problem"
460	set errors "this error"
461	} else {
462	set thereis "There are"
463	set problem "these problems"
464	if {$nwarn+$nother == 0} {
465	set errors "these errors"
466	} else {
467	set errors "at least the $nerrs error"
468	if {$nerrs > 1} {lappend errors "s"}
469	}
470	}
471
472	# if there are errors, we can't continue on
473	if {$nerrs > 0} {
474	if {$strict} {
475	tk_messageBox -icon error -type ok -title "Rappture: Problems with your tool definition" -message "$thereis $phrases for your current tool definition. You must resolve $errors before you continue with the preview."
476	return 1
477	} else {
478	set resp [tk_messageBox -icon error -type yesno -title "Rappture: Problems with your tool definition" -message "$thereis $phrases for your current tool definition. Examine and resolve $problem?"]
479	return $resp
480	}
481	}
482
483	# let the user decide whether to proceed
484	set choice [tk_messageBox -icon error -type yesno -title "Rappture: Problems with your tool definition" -message "$thereis $phrases for your current tool definition. Examine and resolve $problem?"]
485	if {$choice == "yes"} {
486	return 1
487	} else {
488	return 0
489	}
490	}
491	return 0
492	}
493
494	# ----------------------------------------------------------------------
495	# USAGE: main_errors_nav index\|next\|prev
496	#
497	# Navigates through the error messages generated by the last call
498	# to main_errors, putting up the next message in the sequence.
499	# ----------------------------------------------------------------------
500	proc main_errors_nav {where} {
501	global ErrList ErrListPos ErrFocusAttr
502
503	if {![main_options_save]} {
504	return
505	}
506
507	if {$where == "next"} {
508	incr ErrListPos
509	} elseif {$where == "prev"} {
510	incr ErrListPos -1
511	} elseif {[string is integer -strict $where]} {
512	set ErrListPos $where
513	} else {
514	error "bad option \"$where\": should be next or prev"
515	}
516
517	if {$ErrListPos < 0} {
518	set ErrListPos [expr {[llength $ErrList]-1}]
519	} elseif {$ErrListPos >= [llength $ErrList]} {
520	set ErrListPos 0
521	}
522
523	set err [lindex $ErrList $ErrListPos]
524	set class [string totitle [lindex $err 0]]
525	set mesg [lindex $err 1]
526	array set debug [lindex $err 2]
527
528	.func.build.options.errs.info configure -text "$class: $mesg"
529
530	if {$class == "Error"} {
531	.func.build.options.errs.exclaim config -image [Rappture::icon err24]
532	} else {
533	.func.build.options.errs.exclaim config -image [Rappture::icon warn24]
534	}
535
536	set win [.func.build.options.panes pane 0]
537	if {[info exists debug(-attribute)]} {
538	set ErrFocusAttr $debug(-attribute)
539	} else {
540	set ErrFocusAttr ""
541	}
542	$win.scrl.skel select none -silent ;# force a reload of options
543	$win.scrl.skel select $debug(-node) ;# so we can highlight ErrFocusAttr
544
545	# fix the navigation buttons for next/prev error
546	.func.build.options.errs.nav.prev configure \
547	-state [expr {($ErrListPos == 0) ? "disabled" : "normal"}]
548	.func.build.options.errs.nav.next configure \
549	-state [expr {($ErrListPos >= [llength $ErrList]-1) ? "disabled" : "normal"}]
550	}
551
552	# ----------------------------------------------------------------------
553	# USAGE: main_errors_cmp <err1> <err2>
554	#
555	# Used to compare two error records when sorting the main ErrList.
556	# Each record should have the following form:
557	#
558	# error "this describes the error" {-node n -counter c -attribute a}
559	#
560	# Errors appear at the top, followed by warnings and suggestions.
561	# Each record has a counter value, which determines its position in
562	# the tree. Serious errors near the top of the tree are shown first.
563	# ----------------------------------------------------------------------
564	proc main_errors_cmp {err1 err2} {
565	array set severity {
566	suggestion 0
567	warning 1
568	error 2
569	}
570
571	set eclass1 [lindex $err1 0]
572	array set einfo1 [lindex $err1 2]
573
574	set eclass2 [lindex $err2 0]
575	array set einfo2 [lindex $err2 2]
576
577	if {$severity($eclass1) > $severity($eclass2)} {
578	return 1
579	} elseif {$severity($eclass1) < $severity($eclass2)} {
580	return -1
581	}
582	if {$einfo1(-counter) > $einfo2(-counter)} {
583	return -1 ;# higher counters are further down in tree
584	} elseif {$einfo1(-counter) < $einfo2(-counter)} {
585	return 1 ;# put lower counters near the top
586	}
587	return 0
588	}
589
590	# ----------------------------------------------------------------------
591	# USAGE: main_generate_xml
592	#
593	# Builds an XML representation of the current contents of the tool
594	# defintion tree. Usually called just before previewing or saving
595	# the tool to build a fresh XML representation with all changes.
596	# Returns 1 if the XML was successfully generated, and 0 if something
597	# went wrong.
598	# ----------------------------------------------------------------------
599	proc main_generate_xml {} {
600	global ToolXml
601
602	# save any outstanding changes from the current options panel
603	if {![main_options_save]} {
604	return 0
605	}
606
607	# create a fresh XML object
608	if {"" != $ToolXml} {
609	itcl::delete object $ToolXml
610	}
611	set ToolXml [Rappture::LibraryObj ::#auto "<?xml version=\"1.0\"?><run><tool/></run>"]
612
613	set win [.func.build.options.panes pane 0]
614	set hlist $win.scrl.skel
615	set nodelist [$hlist tree children 0]
616	while {[llength $nodelist] > 0} {
617	set node [lindex $nodelist 0]
618	set nodelist [lrange $nodelist 1 end]
619
620	# add children into the node traversal list
621	set cnodes [$hlist tree children $node]
622	if {[llength $cnodes] > 0} {
623	set nodelist [eval linsert [list $nodelist] 0 $cnodes]
624	}
625
626	set path [$hlist tree path $node "%lc:type(%id)"]
627	regsub -all {\(%id\)} $path "" path
628	set type [string tolower [$hlist tree get $node type]]
629	set side [lindex [split $path .] 0]
630
631	if {[catch {Rappture::objects::get $type -attributes} attrdef]
632	\|\| [catch {$hlist tree get $node attributes} attrlist]} {
633	# can't find any attributes for this node or node type
634	continue
635	}
636	array set ainfo $attrlist
637
638	foreach rec $attrdef {
639	set name [lindex $rec 0]
640	if {![info exists ainfo($name)]} {
641	continue
642	}
643	array set info [lrange $rec 1 end]
644
645	# see if this attribute is excluded based on the -only option
646	if {$info(-only) ne "" && [lsearch $info(-only) $side] < 0} {
647	continue ;# skip it!
648	}
649
650	set atype [lindex [split $info(-type) :] 0]
651	set proc "Attr[string totitle $atype]::export"
652	if {[catch {$proc $ToolXml $path.$info(-path) $ainfo($name)} result]} {
653	puts "ERROR: $result"
654	puts " skipping $name attribute of $path"
655	}
656	}
657	}
658	return 1
659	}
660
661	# ----------------------------------------------------------------------
662	# USAGE: main_saveas start\|cancel\|finish\|update\|gettoolfile\|getprogfile
663	#
664	# Handles the Save As... operation, which saves the current tool
665	# information into a tool.xml file. Prompts the user to determine
666	# the save file, and then saves the data--unless the user cancels.
667	# ----------------------------------------------------------------------
668	proc main_saveas {{option "start"}} {
669	global tcl_platform SaveAs ToolXml LastToolXmlFile LastToolXmlLoaded
670
671	switch -- $option {
672	start {
673	if {![main_options_save -clear]} {
674	return
675	}
676	set win [.func.build.options.panes pane 0]
677	$win.scrl.skel select none
678
679	# freshen up the ToolXml
680	if {![main_generate_xml]} {
681	# something went wrong while saving the xml
682	# pull up the build tab, so we can see the error
683	.func select [.func index -name "Build"]
684	return
685	}
686
687	if {[main_errors]} {
688	.func select [.func index -name "Build"]
689	pack .func.build.options.errs \
690	-before .func.build.options.panes \
691	-pady {10 0} -fill x
692	main_errors_nav 0
693	return
694	}
695
696	# get the language choice and update the skeleton program option
697	set lang ""
698	set cmd [$ToolXml get tool.command]
699	if {[string index $cmd 0] == "!"} {
700	set lang [string range $cmd 1 end]
701	} else {
702	# It's hard to reload a real command from a tool.xml file.
703	# Scan through all languages and treat @@FILENAME@@ as a
704	# wildcard. See if any of the languages match.
705	foreach name [RapptureBuilder::templates::languages] {
706	set pat [RapptureBuilder::templates::generate command \
707	-language $name -macros {@@FILENAME@@ * @@FILEROOT@@ *}]
708
709	if {[string match $pat $cmd]} {
710	set lang $name
711	break
712	}
713	}
714	}
715	if {$lang ne ""} {
716	.saveas.opts.prog configure -text "Skeleton program ($lang)" -state normal
717	.saveas.opts.progv.getfile configure -state normal
718	set ext [RapptureBuilder::templates::generate extension -language $lang]
719	.saveas.opts.progv.file configure -text "main$ext"
720	set SaveAs(lang) $lang
721	set SaveAs(ext) $ext
722
723	# see if there's a makefile for this program
724	if {[catch {RapptureBuilder::templates::generate makefile -language $lang}]} {
725	set SaveAs(make) 0
726	.saveas.opts.make configure -state disabled
727	} else {
728	.saveas.opts.make configure -state normal
729	}
730	} else {
731	.saveas.opts.prog configure -text "Skeleton program (select language under Tool section)" -state disabled
732	.saveas.opts.progv.file configure -text "select a file"
733	.saveas.opts.progv.getfile configure -state disabled
734	.saveas.opts.make configure -state disabled
735	set SaveAs(lang) ?
736	set SaveAs(ext) ?
737	set SaveAs(prog) 0
738	set SaveAs(make) 0
739	}
740	main_saveas update
741
742	# make the saveas dialog big enough and center it on the main win
743	set w 400
744	set ho [winfo reqheight .saveas.opts]
745	set hc [winfo reqheight .saveas.cntls]
746	set h [expr {$ho+$hc+40}]
747	set x0 [winfo rootx .]
748	set y0 [winfo rooty .]
749	set wmain [winfo width .]
750	set hmain [winfo height .]
751	set x0 [expr {$x0+($wmain-$w)/2}]
752	set y0 [expr {$y0+($hmain-$h)/2}]
753
754	wm geometry .saveas ${w}x${h}+${x0}+${y0}
755	wm deiconify .saveas
756	raise .saveas
757	grab set .saveas
758
759	# wait for the user to save/cancel and return 1/0
760	vwait SaveAs(status)
761	return [string equal $SaveAs(status) "ok"]
762	}
763
764	cancel {
765	grab release .saveas
766	wm withdraw .saveas
767	after idle [list set SaveAs(status) "cancelled"]
768	}
769
770	finish {
771	grab release .saveas
772	wm withdraw .saveas
773	set status "ok"
774
775	set tfile [.saveas.opts.toolv.file cget -text]
776	set pfile [.saveas.opts.progv.file cget -text]
777
778	if {$SaveAs(tool) && $tfile ne "select a file"} {
779	set tfile [file normalize $tfile]
780
781	if {$SaveAs(prog) && $pfile ne "select a file"} {
782	# if we have a tool.xml file, put the program in same dir
783	set tail [file tail $pfile]
784	set pfile [file join [file dirname $tfile] $tail]
785	}
786	}
787
788	if {$SaveAs(tool) && $tfile ne "select a file"} {
789	# generate again now that we know the file name to get
790	# relative file paths for things like <note>'s
791	set LastToolXmlFile $tfile
792	main_generate_xml
793
794	# change any !Language for the command into a proper
795	# invocation command. Grab the XML before we do this
796	# as the last official XML that's been saved. We'll
797	# know later if things changed and we need to save again.
798	set xmlBeforeCmdSubst [$ToolXml xml]
799
800	set cmd [$ToolXml get tool.command]
801	if {[string index $cmd 0] eq "!"} {
802	if {$pfile eq "select a file"} {
803	set pfile "main$SaveAs(ext)"
804	}
805	set tail [file tail $pfile]
806	set cmd [RapptureBuilder::templates::generate command \
807	-language $SaveAs(lang) \
808	-macros [list @@FILENAME@@ $tail \
809	@@FILEROOT@@ [file rootname $tail]]]
810	$ToolXml put tool.command $cmd
811	}
812
813	set cmds {
814	set fid [open $tfile w]
815	puts $fid "<?xml version=\"1.0\"?>"
816	puts -nonewline $fid [$ToolXml xml]
817	close $fid
818	}
819	if {[catch $cmds result]} {
820	tk_messageBox -icon error -title "Rappture: Error" -message "Error saving tool description: $result"
821	set status "error"
822	} else {
823	set LastToolXmlLoaded $xmlBeforeCmdSubst
824	}
825	}
826
827	if {$SaveAs(prog) && $pfile ne "select a file"} {
828	if {[file exists $pfile]} {
829	set choice [tk_messageBox -icon warning -type yesno -title "Rappture: Confirm" -message "File \"$pfile\" already exists.\n\nOverwrite?"]
830	if {$choice == "no"} {
831	# pop the dialog back up
832	wm deiconify .saveas
833	raise .saveas
834	grab set .saveas
835	return
836	}
837	}
838	set code [RapptureBuilder::templates::generate main \
839	-language $SaveAs(lang) -xmlobj $ToolXml]
840
841	set cmds {
842	set fid [open $pfile w]
843	puts -nonewline $fid $code
844	close $fid
845	}
846	if {[catch $cmds result]} {
847	tk_messageBox -icon error -title "Rappture: Error" -message "Error saving skeleton program file: $result"
848	set status "error"
849	}
850	}
851
852	if {$SaveAs(make)} {
853	if {$pfile eq "select a file"} {
854	set pfile "main$SaveAs(ext)"
855	}
856	set fname [file tail $pfile]
857	set mfile [file join [file dirname $pfile] Makefile]
858	if {[file exists $mfile]} {
859	set choice [tk_messageBox -icon warning -type yesno -title "Rappture: Confirm" -message "File \"$mfile\" already exists.\n\nOverwrite?"]
860	if {$choice == "no"} {
861	# pop the dialog back up
862	wm deiconify .saveas
863	raise .saveas
864	grab set .saveas
865	return
866	}
867	}
868
869	# /apps/rappture/current for 32-bit systems
870	# /apps/share64/rappture/current for 64-bit systems
871	if {$tcl_platform(wordSize) == 8
872	&& [file isdirectory /apps/share64/rappture/current]} {
873	set dir /apps/share64/rappture/current
874	} else {
875	set dir /apps/rappture/current
876	}
877	if {![file isdirectory $dir]} {
878	# if all else fails, ask the current Rappture for its install dir
879	set dir [file dirname [file dirname $::Rappture::installdir]]
880	}
881
882	set macros [list @@RAPPTUREDIR@@ $dir]
883	lappend macros @@FILENAME@@ $fname
884	lappend macros @@FILEROOT@@ [file rootname $fname]
885	if {[catch {RapptureBuilder::templates::generate makefile -language $SaveAs(lang) -macros $macros} code] == 0} {
886	set cmds {
887	set fid [open $mfile w]
888	puts -nonewline $fid $code
889	close $fid
890	}
891	if {[catch $cmds result]} {
892	tk_messageBox -icon error -title "Rappture: Error" -message "Error saving Makefile: $result"
893	set status "error"
894	}
895	}
896	}
897
898	after idle [list set SaveAs(status) $status]
899	}
900
901	update {
902	set havefile 0
903	set missingfile 0
904	set tfile [.saveas.opts.toolv.file cget -text]
905	if {$SaveAs(tool)} {
906	if {$tfile ne "select a file"} {
907	.saveas.opts.toolv.file configure -fg black
908	set havefile 1
909	} else {
910	set missingfile 1
911	}
912	} else {
913	.saveas.opts.toolv.file configure -fg gray60
914	}
915
916	set pfile [.saveas.opts.progv.file cget -text]
917	if {$SaveAs(prog)} {
918	if {$pfile ne "select a file"} {
919	.saveas.opts.progv.file configure -fg black
920	set havefile 1
921	} else {
922	set missingfile 1
923	}
924	} else {
925	.saveas.opts.progv.file configure -fg gray60
926	}
927
928	if {$havefile && !$missingfile} {
929	.saveas.cntls.save configure -state normal
930	} else {
931	.saveas.cntls.save configure -state disabled
932	}
933	}
934
935	gettoolfile {
936	set fname [tk_getSaveFile -title "Rappture: Save Tool" -parent .saveas -initialfile "tool.xml" -defaultextension .xml -filetypes { {{XML files} .xml} {{All files} *} }]
937
938	if {"" != $fname} {
939	.saveas.opts.toolv.file configure -text $fname
940	set SaveAs(tool) 1
941	main_saveas update
942	}
943	}
944
945	getprogfile {
946	set flist ""
947	lappend flist [list "$SaveAs(lang) files" $SaveAs(ext)]
948	lappend flist [list "All files" *]
949
950	set pfile [.saveas.opts.progv.file cget -text]
951	if {$pfile eq "select a file"} {
952	set init ""
953	set ext ""
954	} else {
955	set init $pfile
956	set ext [file extension $pfile]
957	}
958
959	set fname [tk_getSaveFile -title "Rappture: Save Program Skeleton" -parent .saveas -initialfile $init -defaultextension $ext -filetypes $flist]
960
961	if {"" != $fname} {
962	.saveas.opts.progv.file configure -text $fname
963	set SaveAs(prog) 1
964	main_saveas update
965	}
966	}
967
968	default {
969	error "bad option \"$option\": should be start, cancel, finish, gettoolfile, getprogfile"
970	}
971	}
972
973	}
974
975	# ----------------------------------------------------------------------
976	# USAGE: main_exit
977	#
978	# Handles the Save As... operation, which saves the current tool
979	# information into a tool.xml file. Prompts the user to determine
980	# the save file, and then saves the data--unless the user cancels.
981	# ----------------------------------------------------------------------
982	proc main_exit {} {
983	global ToolXml LastToolXmlLoaded
984
985	if {![main_options_save -clear]} {
986	return
987	}
988	set win [.func.build.options.panes pane 0]
989	$win.scrl.skel select none
990
991	main_generate_xml
992
993	if {[$ToolXml xml] ne $LastToolXmlLoaded} {
994	set choice [tk_messageBox -icon warning -type yesnocancel -title "Rappture: Save Changes?" -message "Changes to the current tool haven't been saved.\n\nSave changes?"]
995	if {$choice == "yes" && ![main_saveas]} {
996	return
997	} elseif {$choice == "cancel"} {
998	return
999	}
1000	}
1001	exit
1002	}
1003
1004	# ----------------------------------------------------------------------
1005	# USAGE: main_preview
1006	#
1007	# Handles the "Preview" tab. Whenever a preview is needed, this
1008	# function clears the current contents of the preview window and
1009	# builds a new set of input controls based on the current XML.
1010	# ----------------------------------------------------------------------
1011	proc main_preview {} {
1012	global ToolXml ToolPreview
1013
1014	# while we're checking for errors, put up a striped pattern over
1015	# the preview area
1016	set w [winfo width .func.preview]
1017	set h [winfo height .func.preview]
1018	place .func.preview.stripes -x 0 -y 0 -width $w -height $h
1019	raise .func.preview.stripes
1020
1021	# freshen up the ToolXml
1022	if {![main_generate_xml]} {
1023	# something went wrong while saving the xml
1024	# pull up the build tab, so we can see the error
1025	.func select [.func index -name "Build"]
1026	return
1027	}
1028
1029	if {[main_errors -strict]} {
1030	.func select [.func index -name "Build"]
1031	pack .func.build.options.errs -before .func.build.options.panes \
1032	-pady {10 0} -fill x
1033	main_errors_nav 0
1034	return
1035	}
1036
1037	# clear all current widgets in the preview window
1038	place forget .func.preview.stripes
1039	set win .func.preview
1040	$win.pager delete 0 end
1041
1042	if {"" != $ToolPreview} {
1043	itcl::delete object $ToolPreview
1044	set ToolPreview ""
1045	}
1046	set ToolPreview [Rappture::Tool ::#auto $ToolXml [pwd]]
1047
1048	# add new widgets based on the phases
1049	set phases [$ToolXml children -type phase input]
1050	if {[llength $phases] > 0} {
1051	set plist ""
1052	foreach name $phases {
1053	lappend plist input.$name
1054	}
1055	set phases $plist
1056	} else {
1057	set phases input
1058	}
1059
1060	if {[llength $phases] == 1} {
1061	$win.pager configure -arrangement side-by-side
1062	} else {
1063	$win.pager configure -arrangement pages
1064	}
1065
1066	foreach comp $phases {
1067	if {"" == [$ToolXml element $comp]} {
1068	# empty element? then skip it
1069	continue
1070	}
1071	set title [$ToolXml get $comp.about.label]
1072	if {$title == ""} {
1073	set title "Input #auto"
1074	}
1075	$win.pager insert end -name $comp -title $title
1076
1077	#
1078	# Build the page of input controls for this phase.
1079	#
1080	set f [$win.pager page $comp]
1081	Rappture::Page $f.cntls $ToolPreview $comp
1082	pack $f.cntls -expand yes -fill both
1083	}
1084
1085	# add an analyzer for output widgets
1086	set simtxt [$ToolXml get tool.action.label]
1087	if {"" == $simtxt} {
1088	set simtxt "Simulate"
1089	}
1090	$win.pager insert end -name analyzer -title $simtxt
1091	set f [$win.pager page analyzer]
1092	# note: simcontrol on but disabled due to _simState code above
1093	Rappture::Analyzer $f.analyze $ToolPreview -simcontrol on \
1094	-notebookpage about
1095	pack $f.analyze -expand yes -fill both
1096
1097	# copy the ToolXml object and pass to analyzer to show outputs
1098	set synthrun [Rappture::LibraryObj ::#auto "<?xml version=\"1.0\"?><run><tool/></run>"]
1099	$synthrun copy "" from $ToolXml ""
1100	$f.analyze load $synthrun
1101	$f.analyze configure -notebookpage analyze
1102
1103	# turn off download options and clear button
1104	$f.analyze component download configure -state disabled
1105	$f.analyze component resultselector component clear configure -state disabled
1106	# remove the "---" and "Download..." options from the view selector
1107	$f.analyze component viewselector choices delete end
1108	$f.analyze component viewselector choices delete end
1109	}
1110
1111	# ----------------------------------------------------------------------
1112	# MAIN WINDOW
1113	# ----------------------------------------------------------------------
1114	wm geometry . 800x600
1115	Rappture::Postern .postern
1116	pack .postern -side bottom -fill x
1117
1118	blt::tabset .func -borderwidth 0 -relief flat -side top -tearoff 0 \
1119	-highlightthickness 0
1120	pack .func -expand yes -fill both
1121
1122	# ----------------------------------------------------------------------
1123	# BUILD AREA
1124	# ----------------------------------------------------------------------
1125	frame .func.build
1126	.func insert end "Build" -window .func.build -fill both
1127
1128	frame .func.build.cntls
1129	pack .func.build.cntls -fill x
1130	button .func.build.cntls.new -text "New..." -command {main_open -new}
1131	pack .func.build.cntls.new -side left -padx 2 -pady 4
1132	button .func.build.cntls.open -text "Open..." -command {main_open -file}
1133	pack .func.build.cntls.open -side left -padx 2 -pady 4
1134	button .func.build.cntls.save -text "Save As..." -command main_saveas
1135	pack .func.build.cntls.save -side left -padx 2 -pady 4
1136
1137	frame .func.build.side
1138	pack .func.build.side -side left -fill y -pady 10
1139	label .func.build.side.l -text "Object Types:"
1140	pack .func.build.side.l -side top -anchor w
1141
1142	Rappture::Slideframes .func.build.side.palettes -animstartcommand {
1143	# turn scrollbars off during animation
1144	for {set i 0} {$i < [.func.build.side.palettes size]} {incr i} {
1145	set win [.func.build.side.palettes page @$i]
1146	$win.scrl configure -yscrollmode off
1147	}
1148	} -animendcommand {
1149	# turn scrollbars back on when animation is over
1150	for {set i 0} {$i < [.func.build.side.palettes size]} {incr i} {
1151	set win [.func.build.side.palettes page @$i]
1152	$win.scrl configure -yscrollmode auto
1153	}
1154	}
1155	pack .func.build.side.palettes -expand yes -fill both
1156
1157	set plist [Rappture::objects::palettes]
1158	set plist [linsert $plist 0 "All"]
1159
1160	set pnum 0
1161	foreach ptitle $plist {
1162	set win [.func.build.side.palettes insert end $ptitle]
1163
1164	Rappture::Scroller $win.scrl -xscrollmode off -yscrollmode auto
1165	pack $win.scrl -expand yes -fill both
1166	set iwin [$win.scrl contents frame]
1167	Rappture::Filmstrip $iwin.strip -orient vertical \
1168	-dragdropcommand main_palette_source
1169	pack $iwin.strip -expand yes -fill both
1170
1171	foreach name [lsort [Rappture::objects::get]] {
1172	set imh [Rappture::objects::get $name -image]
1173	if {"" == $imh} {
1174	continue
1175	}
1176	set plist [Rappture::objects::get $name -palettes]
1177	if {$ptitle == "All" \|\| [lsearch $plist $ptitle] >= 0} {
1178	$iwin.strip add $name -image $imh
1179	}
1180	}
1181	}
1182
1183	# ----------------------------------------------------------------------
1184	# OPTIONS AREA
1185	# ----------------------------------------------------------------------
1186	frame .func.build.options
1187	pack .func.build.options -expand yes -fill both -padx 10
1188
1189	frame .func.build.options.errs
1190	frame .func.build.options.errs.nav
1191	pack .func.build.options.errs.nav -side bottom -fill x -padx 2 -pady 2
1192	button .func.build.options.errs.nav.next -text "Next >" -command {main_errors_nav next}
1193	pack .func.build.options.errs.nav.next -side right
1194	button .func.build.options.errs.nav.prev -text "< Prev" -command {main_errors_nav prev}
1195	pack .func.build.options.errs.nav.prev -side right -padx 4
1196
1197	button .func.build.options.errs.x -bitmap [Rappture::icon dismiss] \
1198	-command {pack forget .func.build.options.errs}
1199	pack .func.build.options.errs.x -side right -anchor n -padx 4 -pady 8
1200	label .func.build.options.errs.exclaim -image [Rappture::icon err24]
1201	pack .func.build.options.errs.exclaim -side left -anchor nw -padx 4 -pady 4
1202	label .func.build.options.errs.info -text "" -anchor nw -justify left
1203	pack .func.build.options.errs.info -side left -expand yes -fill both -pady {6 0}
1204	bind .func.build.options.errs.info <Configure> {.func.build.options.errs.info configure -wraplength [expr {%w-4}]}
1205
1206	Rappture::Panes .func.build.options.panes -orientation vertical
1207	pack .func.build.options.panes -expand yes -fill both -padx 10
1208	.func.build.options.panes insert end -fraction 0.5
1209
1210	set win [.func.build.options.panes pane 0]
1211	label $win.heading -text "Tool Interface:"
1212	pack $win.heading -anchor w -pady {12 0}
1213	Rappture::Scroller $win.scrl -xscrollmode auto -yscrollmode auto
1214	pack $win.scrl -expand yes -fill both
1215
1216	Rappture::Hierlist $win.scrl.skel
1217	$win.scrl contents $win.scrl.skel
1218
1219	bind $win.scrl.skel <<Selection>> main_options_load
1220	bind $win.scrl.skel <<SelectionPath>> main_options_rename
1221
1222	set win [.func.build.options.panes pane 1]
1223	Rappture::Scroller $win.vals -xscrollmode none -yscrollmode auto
1224	pack $win.vals -expand yes -fill both
1225
1226	# ----------------------------------------------------------------------
1227	# USAGE: main_options_load
1228	#
1229	# Invoked whenever the selection changes in the tree of all known
1230	# objects. Gets the current selection and pops up controls to edit
1231	# the attributes.
1232	# ----------------------------------------------------------------------
1233	set OptionsPanelNode ""
1234
1235	proc main_options_load {} {
1236	global OptionsPanelNode OptionsPanelObjs ErrFocusAttr
1237
1238	set win [.func.build.options.panes pane 0]
1239	set hlist $win.scrl.skel
1240
1241	if {![main_options_save -clear]} {
1242	# something is wrong with the previous edits
1243	# show the last node as the current selection and fix the error
1244	if {"" != $OptionsPanelNode} {
1245	$hlist select $OptionsPanelNode -silent
1246	}
1247	return
1248	}
1249
1250	# figure out the current selection
1251	set node [$hlist curselection]
1252	set type [$hlist curselection -field type]
1253	set path [$hlist curselection -path "%lc:type(%id)"]
1254	regsub -all {\(%id\)} $path "" path
1255	set side [lindex [split $path .] 0]
1256
1257	# set the value column to expand
1258	set win [.func.build.options.panes pane 1]
1259	set frame [$win.vals contents frame]
1260	grid columnconfigure $frame 1 -weight 1
1261
1262	# create new widgets for each object attribute
1263	if {"" != $type && [lsearch {Inputs Outputs} $type] < 0
1264	&& [catch {Rappture::objects::get $type -attributes} attr] == 0} {
1265
1266	frame $frame.cntls -borderwidth 4 -relief flat
1267	grid $frame.cntls -row 0 -column 0 -columnspan 2 -sticky nsew
1268
1269	if {$type ne "Tool"} {
1270	# can't let people delete the tool info
1271	button $frame.cntls.del -text "Delete" -command main_options_delete
1272	pack $frame.cntls.del -side right
1273	}
1274
1275	button $frame.cntls.help -text "Help" -command main_options_help
1276	pack $frame.cntls.help -side right
1277
1278	# put this in last so it gets squeezed out
1279	Rappture::ObjPath $frame.cntls.path -label "Object" -pathtext $path \
1280	-renamecommand main_options_rename
1281	pack $frame.cntls.path -side left -expand yes -fill both
1282
1283	if {$type eq "Tool"} {
1284	# if this is a tool, then lose the rename button
1285	pack forget [$frame.cntls.path component button]
1286	}
1287
1288	array set ainfo [$hlist curselection -field attributes]
1289
1290	set wnum 1
1291	foreach rec $attr {
1292	catch {unset info}
1293	set name [lindex $rec 0]
1294	array set info [lrange $rec 1 end]
1295
1296	# see if this attribute is excluded based on the -only option
1297	if {$info(-only) ne "" && [lsearch $info(-only) $side] < 0} {
1298	continue ;# skip it!
1299	}
1300
1301	# create the widget to edit this attribute
1302	set atype [split $info(-type) :]
1303	set atname [lindex $atype 0]
1304	set atname "Attr[string totitle $atname]"
1305	set atargs ""
1306	foreach term [split [lindex $atype 1] ,] {
1307	set key [lindex [split $term =] 0]
1308	set val [lindex [split $term =] 1]
1309	if {$key == "validate"} {
1310	set val "validate_$val"
1311	}
1312	lappend atargs -$key $val
1313	}
1314
1315	# add any tooltip info for this attribute
1316	if {[info exists info(-tooltip)] && $info(-tooltip) ne ""} {
1317	lappend atargs -tooltip $info(-tooltip)
1318	}
1319
1320	set win [frame $frame.val$wnum]
1321	if {[catch {eval $atname ::#auto $win $atargs} obj]} {
1322	puts stderr "attribute editor failed: $obj"
1323	destroy $win
1324	continue
1325	}
1326	if {[info exists ainfo($name)]} {
1327	$obj load $ainfo($name)
1328	}
1329	set OptionsPanelObjs($name) $obj
1330
1331	# no title? then use the attribute name as a title
1332	if {[string length $info(-title)] == 0} {
1333	set info(-title) [string totitle $name]
1334	}
1335	label $frame.l$wnum -text "$info(-title):"
1336	grid $frame.l$wnum -row $wnum -column 0 -sticky e -padx 4 -pady 4
1337	grid $win -row $wnum -column 1 -sticky nsew -pady 4
1338	grid rowconfigure $frame $wnum -weight [expr {$info(-expand)? 1:0}]
1339
1340	# if an error was found at this attribute, set focus there
1341	if {$name eq $ErrFocusAttr} {
1342	$obj edit
1343	set errbg [option get $frame errorHighlightColor Background]
1344	$frame.l$wnum configure -background $errbg
1345	set ErrFocusAttr ""
1346	}
1347
1348	incr wnum
1349	}
1350	}
1351
1352	# save this so we know later what node we're editing
1353	set OptionsPanelNode $node
1354	}
1355
1356	# ----------------------------------------------------------------------
1357	# USAGE: main_options_rename ?<name>?
1358	#
1359	# Used to change the id of the current selection to the given <name>.
1360	# ----------------------------------------------------------------------
1361	proc main_options_rename {args} {
1362	set win [.func.build.options.panes pane 0]
1363	set hlist $win.scrl.skel
1364	set node [$hlist curselection]
1365
1366	if {[llength $args] > 0} {
1367	$hlist tree set $node id [lindex $args 0]
1368	}
1369
1370	# get the updated path for this element and show in ObjPath widget
1371	set path [$hlist curselection -path "%lc:type(%id)"]
1372	regsub -all {\(%id\)} $path "" path
1373
1374	set win [.func.build.options.panes pane 1]
1375	set frame [$win.vals contents frame]
1376	$frame.cntls.path configure -pathtext $path
1377	}
1378
1379	# ----------------------------------------------------------------------
1380	# USAGE: main_options_save ?-clear?
1381	#
1382	# Scans through all attribute widgets on the panel showing the current
1383	# object and tells each one to save its value. Returns 1 if successful,
1384	# or 0 if errors are encountered. Any errors are indicated by a popup
1385	# cue under the widget with the bad value.
1386	# ----------------------------------------------------------------------
1387	proc main_options_save {{op -keep}} {
1388	global OptionsPanelNode OptionsPanelObjs
1389	set win [.func.build.options.panes pane 0]
1390
1391	if {$OptionsPanelNode != "" && [catch {$win.scrl.skel tree get $OptionsPanelNode attributes} attrlist] == 0} {
1392	array set ainfo $attrlist
1393
1394	# transfer values from the panel to the ainfo array
1395	foreach name [array names OptionsPanelObjs] {
1396	set obj $OptionsPanelObjs($name)
1397	if {![$obj save ainfo($name)]} {
1398	return 0
1399	}
1400	}
1401
1402	# save current settings back in the tree
1403	$win.scrl.skel tree set $OptionsPanelNode attributes [array get ainfo]
1404	}
1405
1406	if {$op == "-clear"} {
1407	foreach name [array names OptionsPanelObjs] {
1408	itcl::delete object $OptionsPanelObjs($name)
1409	}
1410	catch {unset OptionsPanelObjs}
1411
1412	set bwin [.func.build.options.panes pane 1]
1413	set frame [$bwin.vals contents frame]
1414	foreach w [winfo children $frame] {
1415	destroy $w
1416	}
1417	}
1418	return 1
1419	}
1420
1421	# ----------------------------------------------------------------------
1422	# USAGE: main_options_help
1423	#
1424	# Handles the "Help" button for an object. Pops up a help page
1425	# explaining the object.
1426	# ----------------------------------------------------------------------
1427	proc main_options_help {} {
1428	# delete the node from the tree
1429	set win [.func.build.options.panes pane 0]
1430	set hlist $win.scrl.skel
1431	set node [$hlist curselection]
1432	set type [$hlist curselection -field type]
1433	if {"" != $node} {
1434	# look for a -help option for this node type
1435	set url [Rappture::objects::get $type -help]
1436	if {"" != $url} {
1437	Rappture::filexfer::webpage $url
1438
1439	set win [.func.build.options.panes pane 1]
1440	set frame [$win.vals contents frame]
1441	Rappture::Tooltip::cue $frame.cntls.help "Popping up a web page with additional help information. Making sure your web browser is not blocking pop-ups."
1442	after 2000 [list catch {Rappture::Tooltip::cue hide}]
1443	}
1444	}
1445	}
1446
1447	# ----------------------------------------------------------------------
1448	# USAGE: main_options_delete
1449	#
1450	# Handles the "Delete" button for an object. Deletes the object and
1451	# all of its children from the tree.
1452	# ----------------------------------------------------------------------
1453	proc main_options_delete {} {
1454	global OptionsPanelNode OptionsPanelObjs
1455
1456	# delete the node from the tree
1457	set win [.func.build.options.panes pane 0]
1458	set hlist $win.scrl.skel
1459	set node [$hlist curselection]
1460	if {"" != $node} {
1461	# clear the current panel without saving
1462	foreach name [array names OptionsPanelObjs] {
1463	itcl::delete object $OptionsPanelObjs($name)
1464	}
1465	catch {unset OptionsPanelObjs}
1466
1467	set win [.func.build.options.panes pane 1]
1468	set frame [$win.vals contents frame]
1469	foreach win [winfo children $frame] {
1470	destroy $win
1471	}
1472
1473	# now delete the node itself
1474	$hlist tree delete $node
1475	}
1476	}
1477
1478	# ----------------------------------------------------------------------
1479	# PREVIEW PANEL
1480	# ----------------------------------------------------------------------
1481	frame .func.preview
1482	.func insert end "Preview" -window .func.preview -fill both
1483	Rappture::Pager .func.preview.pager
1484	pack .func.preview.pager -expand yes -fill both
1485
1486	bind .func.preview.pager <Map> main_preview
1487
1488	# use this frame to cover preview before it appears
1489	blt::tile::frame .func.preview.stripes -tile [Rappture::icon diag]
1490
1491	# ----------------------------------------------------------------------
1492	# SAVE AS DIALOG
1493	# ----------------------------------------------------------------------
1494	toplevel .saveas
1495	pack propagate .saveas off
1496	wm title .saveas "Rappture: Save As..."
1497	wm withdraw .saveas
1498	wm protocol .saveas WM_DELETE_WINDOW {.saveas.cntls.cancel invoke}
1499
1500	frame .saveas.cntls
1501	pack .saveas.cntls -side bottom -fill x -padx 4 -pady 4
1502	button .saveas.cntls.cancel -text "Cancel" -underline 0 \
1503	-command {main_saveas cancel}
1504	pack .saveas.cntls.cancel -side right -padx 4 -pady 4
1505	button .saveas.cntls.save -text "Save" -underline 0 -default active \
1506	-command {main_saveas finish} -state disabled
1507	pack .saveas.cntls.save -side right -padx 4 -pady 4
1508
1509	frame .saveas.opts
1510	pack .saveas.opts -expand yes -fill both -padx 10 -pady 10
1511	label .saveas.opts.l -text "What do you want to save?"
1512	pack .saveas.opts.l -side top -anchor w
1513
1514	checkbutton .saveas.opts.tool -text "Tool definition file" -variable SaveAs(tool) -command {main_saveas update}
1515	pack .saveas.opts.tool -side top -anchor w -pady {10 0}
1516	frame .saveas.opts.toolv
1517	pack .saveas.opts.toolv -anchor w
1518	label .saveas.opts.toolv.filel -text "File:" -width 7 -anchor e
1519	pack .saveas.opts.toolv.filel -side left
1520	button .saveas.opts.toolv.getfile -text "Choose..." -command {main_saveas gettoolfile}
1521	pack .saveas.opts.toolv.getfile -side right
1522	label .saveas.opts.toolv.file -text "select a file" -anchor e -fg gray60
1523	pack .saveas.opts.toolv.file -side left -expand yes -fill x
1524	.saveas.opts.tool select
1525
1526	checkbutton .saveas.opts.prog -text "Skeleton program" -variable SaveAs(prog) -command {main_saveas update}
1527	pack .saveas.opts.prog -side top -anchor w -pady {10 0}
1528	frame .saveas.opts.progv
1529	pack .saveas.opts.progv -anchor w
1530	label .saveas.opts.progv.filel -text "File:" -width 7 -anchor e
1531	pack .saveas.opts.progv.filel -side left
1532	button .saveas.opts.progv.getfile -text "Choose..." -command {main_saveas getprogfile}
1533	pack .saveas.opts.progv.getfile -side right
1534	label .saveas.opts.progv.file -text "select a file" -anchor e -fg gray60
1535	pack .saveas.opts.progv.file -side left -expand yes -fill x
1536
1537	checkbutton .saveas.opts.make -text "Makefile for building this program" -variable SaveAs(make) -command {main_saveas update}
1538	pack .saveas.opts.make -side top -anchor w -pady {10 0}
1539
1540	# ----------------------------------------------------------------------
1541	# Open the given XML file or create a new one
1542	# ----------------------------------------------------------------------
1543	set ToolXml ""
1544	set LastToolXmlLoaded ""
1545	set LastToolXmlFile ""
1546	set ToolPreview ""
1547	set ErrFocusAttr ""
1548
1549	if {$params(-tool) ne ""} {
1550	if {![file exists $params(-tool)]} {
1551	puts stderr "can't find tool \"$params(-tool)\""
1552	exit 1
1553	}
1554	main_open $params(-tool)
1555	} elseif {[file exists tool.xml]} {
1556	main_open tool.xml
1557	} else {
1558	main_open -new
1559	}
1560
1561	wm deiconify .

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

Download in other formats: