Context Navigation

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

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

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

Download in other formats: