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

Last change on this file since 3177 was 3177, checked in by mmc, 10 years ago

Updated all of the copyright notices to reference the transfer to
the new HUBzero Foundation, LLC.

File size: 56.7 KB
Line 
1# ----------------------------------------------------------------------
2#  USER INTERFACE BUILDER
3#
4#  This program allows the user to create a tool.xml file, or reload
5#  and edit an existing tool.xml.  It also produces some skeleton
6#  code for the main program that queries inputs and saves outputs.
7#
8#  RUN AS FOLLOWS:
9#    wish main.tcl ?-tool <toolfile>?
10#
11#  If the <toolfile> is not specified, it defaults to "tool.xml" in
12#  the current working directory.
13#
14# ======================================================================
15#  AUTHOR:  Michael McLennan, Purdue University
16#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
17#
18#  See the file "license.terms" for information on usage and
19#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
20# ======================================================================
21
22# take the main window down for now, so we can avoid a flash on the screen
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                if {$tcl_platform(wordSize) == 8
872                      && [file isdirectory /apps/share64/rappture/current]} {
873                    set dir /apps/share64/rappture/current
874                } else {
875                    set dir /apps/rappture/current
876                }
877                if {![file isdirectory $dir]} {
878                    # if all else fails, ask the current Rappture for its install dir
879                    set dir [file dirname [file dirname $::Rappture::installdir]]
880                }
881
882                set macros [list @@RAPPTUREDIR@@ $dir]
883                lappend macros @@FILENAME@@ $fname
884                lappend macros @@FILEROOT@@ [file rootname $fname]
885                if {[catch {RapptureBuilder::templates::generate makefile -language $SaveAs(lang) -macros $macros} code] == 0} {
886                    set cmds {
887                        set fid [open $mfile w]
888                        puts -nonewline $fid $code
889                        close $fid
890                    }
891                    if {[catch $cmds result]} {
892                        tk_messageBox -icon error -title "Rappture: Error" -message "Error saving Makefile: $result"
893                        set status "error"
894                    }
895                }
896            }
897
898            after idle [list set SaveAs(status) $status]
899        }
900
901        update {
902            set havefile 0
903            set missingfile 0
904            set tfile [.saveas.opts.toolv.file cget -text]
905            if {$SaveAs(tool)} {
906                if {$tfile ne "select a file"} {
907                    .saveas.opts.toolv.file configure -fg black
908                    set havefile 1
909                } else {
910                    set missingfile 1
911                }
912            } else {
913                .saveas.opts.toolv.file configure -fg gray60
914            }
915
916            set pfile [.saveas.opts.progv.file cget -text]
917            if {$SaveAs(prog)} {
918                if {$pfile ne "select a file"} {
919                    .saveas.opts.progv.file configure -fg black
920                    set havefile 1
921                } else {
922                    set missingfile 1
923                }
924            } else {
925                .saveas.opts.progv.file configure -fg gray60
926            }
927
928            if {$havefile && !$missingfile} {
929                .saveas.cntls.save configure -state normal
930            } else {
931                .saveas.cntls.save configure -state disabled
932            }
933        }
934
935        gettoolfile {
936            set fname [tk_getSaveFile -title "Rappture: Save Tool" -parent .saveas -initialfile "tool.xml" -defaultextension .xml -filetypes { {{XML files} .xml} {{All files} *} }]
937
938            if {"" != $fname} {
939                .saveas.opts.toolv.file configure -text $fname
940                set SaveAs(tool) 1
941                main_saveas update
942            }
943        }
944
945        getprogfile {
946            set flist ""
947            lappend flist [list "$SaveAs(lang) files" $SaveAs(ext)]
948            lappend flist [list "All files" *]
949
950            set pfile [.saveas.opts.progv.file cget -text]
951            if {$pfile eq "select a file"} {
952                set init ""
953                set ext ""
954            } else {
955                set init $pfile
956                set ext [file extension $pfile]
957            }
958
959            set fname [tk_getSaveFile -title "Rappture: Save Program Skeleton" -parent .saveas -initialfile $init -defaultextension $ext -filetypes $flist]
960
961            if {"" != $fname} {
962                .saveas.opts.progv.file configure -text $fname
963                set SaveAs(prog) 1
964                main_saveas update
965            }
966        }
967
968        default {
969            error "bad option \"$option\": should be start, cancel, finish, gettoolfile, getprogfile"
970        }
971    }
972
973}
974
975# ----------------------------------------------------------------------
976# USAGE: main_exit
977#
978# Handles the Save As... operation, which saves the current tool
979# information into a tool.xml file.  Prompts the user to determine
980# the save file, and then saves the data--unless the user cancels.
981# ----------------------------------------------------------------------
982proc main_exit {} {
983    global ToolXml LastToolXmlLoaded
984
985    if {![main_options_save -clear]} {
986        return
987    }
988    set win [.func.build.options.panes pane 0]
989    $win.scrl.skel select none
990
991    main_generate_xml
992
993    if {[$ToolXml xml] ne $LastToolXmlLoaded} {
994        set choice [tk_messageBox -icon warning -type yesnocancel -title "Rappture: Save Changes?" -message "Changes to the current tool haven't been saved.\n\nSave changes?"]
995        if {$choice == "yes" && ![main_saveas]} {
996            return
997        } elseif {$choice == "cancel"} {
998            return
999        }
1000    }
1001    exit
1002}
1003
1004# ----------------------------------------------------------------------
1005# USAGE: main_preview
1006#
1007# Handles the "Preview" tab.  Whenever a preview is needed, this
1008# function clears the current contents of the preview window and
1009# builds a new set of input controls based on the current XML.
1010# ----------------------------------------------------------------------
1011proc main_preview {} {
1012    global ToolXml ToolPreview
1013
1014    # while we're checking for errors, put up a striped pattern over
1015    # the preview area
1016    set w [winfo width .func.preview]
1017    set h [winfo height .func.preview]
1018    place .func.preview.stripes -x 0 -y 0 -width $w -height $h
1019    raise .func.preview.stripes
1020
1021    # freshen up the ToolXml
1022    if {![main_generate_xml]} {
1023        # something went wrong while saving the xml
1024        # pull up the build tab, so we can see the error
1025        .func select [.func index -name "Build"]
1026        return
1027    }
1028
1029    if {[main_errors -strict]} {
1030        .func select [.func index -name "Build"]
1031        pack .func.build.options.errs -before .func.build.options.panes \
1032            -pady {10 0} -fill x
1033        main_errors_nav 0
1034        return
1035    }
1036
1037    # clear all current widgets in the preview window
1038    place forget .func.preview.stripes
1039    set win .func.preview
1040    $win.pager delete 0 end
1041
1042    if {"" != $ToolPreview} {
1043        itcl::delete object $ToolPreview
1044        set ToolPreview ""
1045    }
1046    set ToolPreview [Rappture::Tool ::#auto $ToolXml [pwd]]
1047
1048    # add new widgets based on the phases
1049    set phases [$ToolXml children -type phase input]
1050    if {[llength $phases] > 0} {
1051        set plist ""
1052        foreach name $phases {
1053            lappend plist input.$name
1054        }
1055        set phases $plist
1056    } else {
1057        set phases input
1058    }
1059
1060    if {[llength $phases] == 1} {
1061        $win.pager configure -arrangement side-by-side
1062    } else {
1063        $win.pager configure -arrangement pages
1064    }
1065
1066    foreach comp $phases {
1067        if {"" == [$ToolXml element $comp]} {
1068            # empty element? then skip it
1069            continue
1070        }
1071        set title [$ToolXml get $comp.about.label]
1072        if {$title == ""} {
1073            set title "Input #auto"
1074        }
1075        $win.pager insert end -name $comp -title $title
1076
1077        #
1078        # Build the page of input controls for this phase.
1079        #
1080        set f [$win.pager page $comp]
1081        Rappture::Page $f.cntls $ToolPreview $comp
1082        pack $f.cntls -expand yes -fill both
1083    }
1084
1085    # add an analyzer for output widgets
1086    set simtxt [$ToolXml get tool.action.label]
1087    if {"" == $simtxt} {
1088        set simtxt "Simulate"
1089    }
1090    $win.pager insert end -name analyzer -title $simtxt
1091    set f [$win.pager page analyzer]
1092    # note: simcontrol on but disabled due to _simState code above
1093    Rappture::Analyzer $f.analyze $ToolPreview -simcontrol on \
1094        -notebookpage about
1095    pack $f.analyze -expand yes -fill both
1096
1097    # copy the ToolXml object and pass to analyzer to show outputs
1098    set synthrun [Rappture::LibraryObj ::#auto "<?xml version=\"1.0\"?><run><tool/></run>"]
1099    $synthrun copy "" from $ToolXml ""
1100    $f.analyze load $synthrun
1101    $f.analyze configure -notebookpage analyze
1102
1103    # turn off download options and clear button
1104    $f.analyze component download configure -state disabled
1105    $f.analyze component resultselector component clear configure -state disabled
1106    # remove the "---" and "Download..." options from the view selector
1107    $f.analyze component viewselector choices delete end
1108    $f.analyze component viewselector choices delete end
1109}
1110
1111# ----------------------------------------------------------------------
1112# MAIN WINDOW
1113# ----------------------------------------------------------------------
1114wm geometry . 800x600
1115Rappture::Postern .postern
1116pack .postern -side bottom -fill x
1117
1118blt::tabset .func -borderwidth 0 -relief flat -side top -tearoff 0 \
1119    -highlightthickness 0
1120pack .func -expand yes -fill both
1121
1122# ----------------------------------------------------------------------
1123# BUILD AREA
1124# ----------------------------------------------------------------------
1125frame .func.build
1126.func insert end "Build" -window .func.build -fill both
1127
1128frame .func.build.cntls
1129pack .func.build.cntls -fill x
1130button .func.build.cntls.new -text "New..." -command {main_open -new}
1131pack .func.build.cntls.new -side left -padx 2 -pady 4
1132button .func.build.cntls.open -text "Open..." -command {main_open -file}
1133pack .func.build.cntls.open -side left -padx 2 -pady 4
1134button .func.build.cntls.save -text "Save As..." -command main_saveas
1135pack .func.build.cntls.save -side left -padx 2 -pady 4
1136
1137frame .func.build.side
1138pack .func.build.side -side left -fill y -pady 10
1139label .func.build.side.l -text "Object Types:"
1140pack .func.build.side.l -side top -anchor w
1141
1142Rappture::Slideframes .func.build.side.palettes -animstartcommand {
1143    # turn scrollbars off during animation
1144    for {set i 0} {$i < [.func.build.side.palettes size]} {incr i} {
1145        set win [.func.build.side.palettes page @$i]
1146        $win.scrl configure -yscrollmode off
1147    }
1148} -animendcommand {
1149    # turn scrollbars back on when animation is over
1150    for {set i 0} {$i < [.func.build.side.palettes size]} {incr i} {
1151        set win [.func.build.side.palettes page @$i]
1152        $win.scrl configure -yscrollmode auto
1153    }
1154}
1155pack .func.build.side.palettes -expand yes -fill both
1156
1157set plist [Rappture::objects::palettes]
1158set plist [linsert $plist 0 "All"]
1159
1160set pnum 0
1161foreach ptitle $plist {
1162    set win [.func.build.side.palettes insert end $ptitle]
1163
1164    Rappture::Scroller $win.scrl -xscrollmode off -yscrollmode auto
1165    pack $win.scrl -expand yes -fill both
1166    set iwin [$win.scrl contents frame]
1167    Rappture::Filmstrip $iwin.strip -orient vertical \
1168        -dragdropcommand main_palette_source
1169    pack $iwin.strip -expand yes -fill both
1170
1171    foreach name [lsort [Rappture::objects::get]] {
1172        set imh [Rappture::objects::get $name -image]
1173        if {"" == $imh} {
1174            continue
1175        }
1176        set plist [Rappture::objects::get $name -palettes]
1177        if {$ptitle == "All" || [lsearch $plist $ptitle] >= 0} {
1178            $iwin.strip add $name -image $imh
1179        }
1180    }
1181}
1182
1183# ----------------------------------------------------------------------
1184#  OPTIONS AREA
1185# ----------------------------------------------------------------------
1186frame .func.build.options
1187pack .func.build.options -expand yes -fill both -padx 10
1188
1189frame .func.build.options.errs
1190frame .func.build.options.errs.nav
1191pack .func.build.options.errs.nav -side bottom -fill x -padx 2 -pady 2
1192button .func.build.options.errs.nav.next -text "Next >" -command {main_errors_nav next}
1193pack .func.build.options.errs.nav.next -side right
1194button .func.build.options.errs.nav.prev -text "< Prev" -command {main_errors_nav prev}
1195pack .func.build.options.errs.nav.prev -side right -padx 4
1196
1197button .func.build.options.errs.x -bitmap [Rappture::icon dismiss] \
1198    -command {pack forget .func.build.options.errs}
1199pack .func.build.options.errs.x -side right -anchor n -padx 4 -pady 8
1200label .func.build.options.errs.exclaim -image [Rappture::icon err24]
1201pack .func.build.options.errs.exclaim -side left -anchor nw -padx 4 -pady 4
1202label .func.build.options.errs.info -text "" -anchor nw -justify left
1203pack .func.build.options.errs.info -side left -expand yes -fill both -pady {6 0}
1204bind .func.build.options.errs.info <Configure> {.func.build.options.errs.info configure -wraplength [expr {%w-4}]}
1205
1206Rappture::Panes .func.build.options.panes -orientation vertical
1207pack .func.build.options.panes -expand yes -fill both -padx 10
1208.func.build.options.panes insert end -fraction 0.5
1209
1210set win [.func.build.options.panes pane 0]
1211label $win.heading -text "Tool Interface:"
1212pack $win.heading -anchor w -pady {12 0}
1213Rappture::Scroller $win.scrl -xscrollmode auto -yscrollmode auto
1214pack $win.scrl -expand yes -fill both
1215
1216Rappture::Hierlist $win.scrl.skel
1217$win.scrl contents $win.scrl.skel
1218
1219bind $win.scrl.skel <<Selection>> main_options_load
1220bind $win.scrl.skel <<SelectionPath>> main_options_rename
1221
1222set win [.func.build.options.panes pane 1]
1223Rappture::Scroller $win.vals -xscrollmode none -yscrollmode auto
1224pack $win.vals -expand yes -fill both
1225
1226# ----------------------------------------------------------------------
1227# USAGE: main_options_load
1228#
1229# Invoked whenever the selection changes in the tree of all known
1230# objects.  Gets the current selection and pops up controls to edit
1231# the attributes.
1232# ----------------------------------------------------------------------
1233set OptionsPanelNode ""
1234
1235proc main_options_load {} {
1236    global OptionsPanelNode OptionsPanelObjs ErrFocusAttr
1237
1238    set win [.func.build.options.panes pane 0]
1239    set hlist $win.scrl.skel
1240
1241    if {![main_options_save -clear]} {
1242        # something is wrong with the previous edits
1243        # show the last node as the current selection and fix the error
1244        if {"" != $OptionsPanelNode} {
1245            $hlist select $OptionsPanelNode -silent
1246        }
1247        return
1248    }
1249
1250    # figure out the current selection
1251    set node [$hlist curselection]
1252    set type [$hlist curselection -field type]
1253    set path [$hlist curselection -path "%lc:type(%id)"]
1254    regsub -all {\(%id\)} $path "" path
1255    set side [lindex [split $path .] 0]
1256
1257    # set the value column to expand
1258    set win [.func.build.options.panes pane 1]
1259    set frame [$win.vals contents frame]
1260    grid columnconfigure $frame 1 -weight 1
1261
1262    # create new widgets for each object attribute
1263    if {"" != $type && [lsearch {Inputs Outputs} $type] < 0
1264          && [catch {Rappture::objects::get $type -attributes} attr] == 0} {
1265
1266        frame $frame.cntls -borderwidth 4 -relief flat
1267        grid $frame.cntls -row 0 -column 0 -columnspan 2 -sticky nsew
1268
1269        if {$type ne "Tool"} {
1270            # can't let people delete the tool info
1271            button $frame.cntls.del -text "Delete" -command main_options_delete
1272            pack $frame.cntls.del -side right
1273        }
1274
1275        button $frame.cntls.help -text "Help" -command main_options_help
1276        pack $frame.cntls.help -side right
1277
1278        # put this in last so it gets squeezed out
1279        Rappture::ObjPath $frame.cntls.path -label "Object" -pathtext $path \
1280            -renamecommand main_options_rename
1281        pack $frame.cntls.path -side left -expand yes -fill both
1282
1283        if {$type eq "Tool"} {
1284            # if this is a tool, then lose the rename button
1285            pack forget [$frame.cntls.path component button]
1286        }
1287
1288        array set ainfo [$hlist curselection -field attributes]
1289
1290        set wnum 1
1291        foreach rec $attr {
1292            catch {unset info}
1293            set name [lindex $rec 0]
1294            array set info [lrange $rec 1 end]
1295
1296            # see if this attribute is excluded based on the -only option
1297            if {$info(-only) ne "" && [lsearch $info(-only) $side] < 0} {
1298                continue  ;# skip it!
1299            }
1300
1301            # create the widget to edit this attribute
1302            set atype [split $info(-type) :]
1303            set atname [lindex $atype 0]
1304            set atname "Attr[string totitle $atname]"
1305            set atargs ""
1306            foreach term [split [lindex $atype 1] ,] {
1307                set key [lindex [split $term =] 0]
1308                set val [lindex [split $term =] 1]
1309                if {$key == "validate"} {
1310                    set val "validate_$val"
1311                }
1312                lappend atargs -$key $val
1313            }
1314
1315            # add any tooltip info for this attribute
1316            if {[info exists info(-tooltip)] && $info(-tooltip) ne ""} {
1317                lappend atargs -tooltip $info(-tooltip)
1318            }
1319
1320            set win [frame $frame.val$wnum]
1321            if {[catch {eval $atname ::#auto $win $atargs} obj]} {
1322                puts stderr "attribute editor failed: $obj"
1323                destroy $win
1324                continue
1325            }
1326            if {[info exists ainfo($name)]} {
1327                $obj load $ainfo($name)
1328            }
1329            set OptionsPanelObjs($name) $obj
1330
1331            # no title? then use the attribute name as a title
1332            if {[string length $info(-title)] == 0} {
1333                set info(-title) [string totitle $name]
1334            }
1335            label $frame.l$wnum -text "$info(-title):"
1336            grid $frame.l$wnum -row $wnum -column 0 -sticky e -padx 4 -pady 4
1337            grid $win -row $wnum -column 1 -sticky nsew -pady 4
1338            grid rowconfigure $frame $wnum -weight [expr {$info(-expand)? 1:0}]
1339
1340            # if an error was found at this attribute, set focus there
1341            if {$name eq $ErrFocusAttr} {
1342                $obj edit
1343                set errbg [option get $frame errorHighlightColor Background]
1344                $frame.l$wnum configure -background $errbg
1345                set ErrFocusAttr ""
1346            }
1347
1348            incr wnum
1349        }
1350    }
1351
1352    # save this so we know later what node we're editing
1353    set OptionsPanelNode $node
1354}
1355
1356# ----------------------------------------------------------------------
1357# USAGE: main_options_rename ?<name>?
1358#
1359# Used to change the id of the current selection to the given <name>.
1360# ----------------------------------------------------------------------
1361proc main_options_rename {args} {
1362    set win [.func.build.options.panes pane 0]
1363    set hlist $win.scrl.skel
1364    set node [$hlist curselection]
1365
1366    if {[llength $args] > 0} {
1367        $hlist tree set $node id [lindex $args 0]
1368    }
1369
1370    # get the updated path for this element and show in ObjPath widget
1371    set path [$hlist curselection -path "%lc:type(%id)"]
1372    regsub -all {\(%id\)} $path "" path
1373
1374    set win [.func.build.options.panes pane 1]
1375    set frame [$win.vals contents frame]
1376    $frame.cntls.path configure -pathtext $path
1377}
1378
1379# ----------------------------------------------------------------------
1380# USAGE: main_options_save ?-clear?
1381#
1382# Scans through all attribute widgets on the panel showing the current
1383# object and tells each one to save its value.  Returns 1 if successful,
1384# or 0 if errors are encountered.  Any errors are indicated by a popup
1385# cue under the widget with the bad value.
1386# ----------------------------------------------------------------------
1387proc main_options_save {{op -keep}} {
1388    global OptionsPanelNode OptionsPanelObjs
1389    set win [.func.build.options.panes pane 0]
1390
1391    if {$OptionsPanelNode != "" && [catch {$win.scrl.skel tree get $OptionsPanelNode attributes} attrlist] == 0} {
1392        array set ainfo $attrlist
1393
1394        # transfer values from the panel to the ainfo array
1395        foreach name [array names OptionsPanelObjs] {
1396            set obj $OptionsPanelObjs($name)
1397            if {![$obj save ainfo($name)]} {
1398                return 0
1399            }
1400        }
1401
1402        # save current settings back in the tree
1403        $win.scrl.skel tree set $OptionsPanelNode attributes [array get ainfo]
1404    }
1405
1406    if {$op == "-clear"} {
1407        foreach name [array names OptionsPanelObjs] {
1408            itcl::delete object $OptionsPanelObjs($name)
1409        }
1410        catch {unset OptionsPanelObjs}
1411
1412        set bwin [.func.build.options.panes pane 1]
1413        set frame [$bwin.vals contents frame]
1414        foreach w [winfo children $frame] {
1415            destroy $w
1416        }
1417    }
1418    return 1
1419}
1420
1421# ----------------------------------------------------------------------
1422# USAGE: main_options_help
1423#
1424# Handles the "Help" button for an object.  Pops up a help page
1425# explaining the object.
1426# ----------------------------------------------------------------------
1427proc main_options_help {} {
1428    # delete the node from the tree
1429    set win [.func.build.options.panes pane 0]
1430    set hlist $win.scrl.skel
1431    set node [$hlist curselection]
1432    set type [$hlist curselection -field type]
1433    if {"" != $node} {
1434        # look for a -help option for this node type
1435        set url [Rappture::objects::get $type -help]
1436        if {"" != $url} {
1437            Rappture::filexfer::webpage $url
1438
1439            set win [.func.build.options.panes pane 1]
1440            set frame [$win.vals contents frame]
1441            Rappture::Tooltip::cue $frame.cntls.help "Popping up a web page with additional help information.  Making sure your web browser is not blocking pop-ups."
1442            after 2000 [list catch {Rappture::Tooltip::cue hide}]
1443        }
1444    }
1445}
1446
1447# ----------------------------------------------------------------------
1448# USAGE: main_options_delete
1449#
1450# Handles the "Delete" button for an object.  Deletes the object and
1451# all of its children from the tree.
1452# ----------------------------------------------------------------------
1453proc main_options_delete {} {
1454    global OptionsPanelNode OptionsPanelObjs
1455
1456    # delete the node from the tree
1457    set win [.func.build.options.panes pane 0]
1458    set hlist $win.scrl.skel
1459    set node [$hlist curselection]
1460    if {"" != $node} {
1461        # clear the current panel without saving
1462        foreach name [array names OptionsPanelObjs] {
1463            itcl::delete object $OptionsPanelObjs($name)
1464        }
1465        catch {unset OptionsPanelObjs}
1466
1467        set win [.func.build.options.panes pane 1]
1468        set frame [$win.vals contents frame]
1469        foreach win [winfo children $frame] {
1470            destroy $win
1471        }
1472
1473        # now delete the node itself
1474        $hlist tree delete $node
1475    }
1476}
1477
1478# ----------------------------------------------------------------------
1479#  PREVIEW PANEL
1480# ----------------------------------------------------------------------
1481frame .func.preview
1482.func insert end "Preview" -window .func.preview -fill both
1483Rappture::Pager .func.preview.pager
1484pack .func.preview.pager -expand yes -fill both
1485
1486bind .func.preview.pager <Map> main_preview
1487
1488# use this frame to cover preview before it appears
1489blt::tile::frame .func.preview.stripes -tile [Rappture::icon diag]
1490
1491# ----------------------------------------------------------------------
1492#  SAVE AS DIALOG
1493# ----------------------------------------------------------------------
1494toplevel .saveas
1495pack propagate .saveas off
1496wm title .saveas "Rappture: Save As..."
1497wm withdraw .saveas
1498wm protocol .saveas WM_DELETE_WINDOW {.saveas.cntls.cancel invoke}
1499
1500frame .saveas.cntls
1501pack .saveas.cntls -side bottom -fill x -padx 4 -pady 4
1502button .saveas.cntls.cancel -text "Cancel" -underline 0 \
1503    -command {main_saveas cancel}
1504pack .saveas.cntls.cancel -side right -padx 4 -pady 4
1505button .saveas.cntls.save -text "Save" -underline 0 -default active \
1506    -command {main_saveas finish} -state disabled
1507pack .saveas.cntls.save -side right -padx 4 -pady 4
1508
1509frame .saveas.opts
1510pack .saveas.opts -expand yes -fill both -padx 10 -pady 10
1511label .saveas.opts.l -text "What do you want to save?"
1512pack .saveas.opts.l -side top -anchor w
1513
1514checkbutton .saveas.opts.tool -text "Tool definition file" -variable SaveAs(tool) -command {main_saveas update}
1515pack .saveas.opts.tool -side top -anchor w -pady {10 0}
1516frame .saveas.opts.toolv
1517pack .saveas.opts.toolv -anchor w
1518label .saveas.opts.toolv.filel -text "File:" -width 7 -anchor e
1519pack .saveas.opts.toolv.filel -side left
1520button .saveas.opts.toolv.getfile -text "Choose..." -command {main_saveas gettoolfile}
1521pack .saveas.opts.toolv.getfile -side right
1522label .saveas.opts.toolv.file -text "select a file" -anchor e -fg gray60
1523pack .saveas.opts.toolv.file -side left -expand yes -fill x
1524.saveas.opts.tool select
1525
1526checkbutton .saveas.opts.prog -text "Skeleton program" -variable SaveAs(prog) -command {main_saveas update}
1527pack .saveas.opts.prog -side top -anchor w -pady {10 0}
1528frame .saveas.opts.progv
1529pack .saveas.opts.progv -anchor w
1530label .saveas.opts.progv.filel -text "File:" -width 7 -anchor e
1531pack .saveas.opts.progv.filel -side left
1532button .saveas.opts.progv.getfile -text "Choose..." -command {main_saveas getprogfile}
1533pack .saveas.opts.progv.getfile -side right
1534label .saveas.opts.progv.file -text "select a file" -anchor e -fg gray60
1535pack .saveas.opts.progv.file -side left -expand yes -fill x
1536
1537checkbutton .saveas.opts.make -text "Makefile for building this program" -variable SaveAs(make) -command {main_saveas update}
1538pack .saveas.opts.make -side top -anchor w -pady {10 0}
1539
1540# ----------------------------------------------------------------------
1541#  Open the given XML file or create a new one
1542# ----------------------------------------------------------------------
1543set ToolXml ""
1544set LastToolXmlLoaded ""
1545set LastToolXmlFile ""
1546set ToolPreview ""
1547set ErrFocusAttr ""
1548
1549if {$params(-tool) ne ""} {
1550    if {![file exists $params(-tool)]} {
1551        puts stderr "can't find tool \"$params(-tool)\""
1552        exit 1
1553    }
1554    main_open $params(-tool)
1555} elseif {[file exists tool.xml]} {
1556    main_open tool.xml
1557} else {
1558    main_open -new
1559}
1560
1561wm deiconify .
Note: See TracBrowser for help on using the repository browser.