Context Navigation

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

Last change on this file since 3177 was 3177, checked in by mmc, 12 years ago
Updated all of the copyright notices to reference the transfer to the new HUBzero Foundation, LLC.
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: