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

Last change on this file since 3989 was 3989, 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                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.