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

Last change on this file since 4503 was 4400, checked in by ldelgass, 6 years ago

Merge builder path fix from 1.3 branch

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