Context Navigation

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

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

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

Download in other formats: