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

Last change on this file since 3988 was 3988, checked in by gah, 9 years ago

fix typo in AdjustSettings? for vtkvolumeviewer

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