source: trunk/gui/scripts/loader.tcl @ 1263

Last change on this file since 1263 was 1263, checked in by dkearney, 15 years ago

fix for bug regarding loader where <new> option no longer loads the new file.

File size: 16.8 KB
RevLine 
[11]1# ----------------------------------------------------------------------
2#  COMPONENT: loader - widget for loading examples and old runs
3#
4#  This widget is a glorified combobox that is used to load various
5#  example files into the application.
6# ======================================================================
7#  AUTHOR:  Michael McLennan, Purdue University
[115]8#  Copyright (c) 2004-2005  Purdue Research Foundation
9#
10#  See the file "license.terms" for information on usage and
11#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
[11]12# ======================================================================
13package require Itk
14
15option add *Loader.textForeground black widgetDefault
16option add *Loader.textBackground white widgetDefault
17
18itcl::class Rappture::Loader {
19    inherit itk::Widget
20
21    itk_option define -tool tool Tool ""
[437]22    itk_option define -state state State "normal"
[11]23
[22]24    constructor {owner path args} { # defined below }
[640]25    destructor { # defined below }
[11]26
27    public method value {args}
28
29    public method label {}
30    public method tooltip {}
31
32    protected method _newValue {}
[640]33    protected method _uploadValue {path args}
34    protected method _downloadValues {}
[11]35    protected method _tooltip {}
36
[22]37    private variable _owner ""    ;# thing managing this control
[11]38    private variable _path ""     ;# path in XML to this loader
[201]39    private variable _lastlabel "";# label of last example loaded
[193]40
[640]41    private variable _uppath ""   ;# list: path label desc ...
42    private variable _dnpaths ""  ;# list of download element paths
43    private common _dnpath2state  ;# maps download path => yes/no state
[1225]44    private variable _copyfrom "" ;# copy xml objects from here in example lib
45    private variable _copyto ""   ;# copy xml objects here in example lib
46    private variable _label2file  ;# maps combobox labels to filenames
[11]47}
48
49itk::usual Loader {
50    keep -cursor -font
51    keep -foreground -background
52    keep -textforeground -textbackground
53    keep -selectbackground -selectforeground -selectborderwidth
54}
55
56# ----------------------------------------------------------------------
57# CONSTRUCTOR
58# ----------------------------------------------------------------------
[22]59itcl::body Rappture::Loader::constructor {owner path args} {
60    if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 || !$valid} {
61        error "bad object \"$owner\": should be Rappture::ControlOwner"
[11]62    }
[22]63    set _owner $owner
[11]64    set _path $path
65
66    itk_component add combo {
67        Rappture::Combobox $itk_interior.combo -editable no
68    } {
69        usual
70        keep -width
71    }
72    pack $itk_component(combo) -expand yes -fill both
73    bind $itk_component(combo) <<Value>> [itcl::code $this _newValue]
74
75    eval itk_initialize $args
76
[201]77    # example files are stored here
78    if {$itk_option(-tool) != ""} {
79        set fdir [$itk_option(-tool) installdir]
80    } else {
81        set fdir "."
82    }
83    set defval [$_owner xml get $path.default]
84
[11]85    #
[201]86    # If this loader has a <new> section, then create that
[193]87    # entry first.
88    #
[201]89    set newfile ""
90    foreach comp [$_owner xml children -type new $path] {
91        set name [$_owner xml get $path.$comp]
92        set fname [file join $fdir examples $name]
93
94        if {[file exists $fname]} {
95            set newfile $fname
[1263]96
[201]97            if {[catch {set obj [Rappture::library $fname]} result]} {
98                puts stderr "WARNING: can't load example file \"$fname\""
99                puts stderr "  $result"
100            } else {
[1263]101                set label "New"
102                $itk_component(combo) choices insert end $obj $label
103
104                # if this is new, add it to the label->file hash
105                if {![info exists entries($label)]} {
106                    set entries($label) $obj
107                    set _label2file($label) [file tail $fname]
108                }
109
[201]110                # translate default file name => default label
111                if {[string equal $defval [file tail $fname]]} {
112                    $_owner xml put $path.default "New"
113                }
114            }
115            break
116        } else {
117            puts stderr "WARNING: missing example file \"$fname\""
118        }
119    }
120
121    #
122    # If this loader has an <upload> section, then create that
123    # entry next.
124    #
[193]125    foreach comp [$_owner xml children -type upload $path] {
[640]126        foreach tcomp [$_owner xml children -type to $path.$comp] {
127            set topath [$_owner xml get $path.$comp.$tcomp]
128            set label [$_owner xml get $topath.about.label]
129            set desc [$_owner xml get $topath.about.description]
130            lappend _uppath $topath $label $desc
[193]131        }
[640]132        break
[193]133    }
[640]134    if {[llength $_uppath] > 0} {
[1077]135        $itk_component(combo) choices insert end \
136            @upload [Rappture::filexfer::label upload]
[640]137    }
[193]138
139    #
[201]140    # If this loader has a <download> section, then create that
[640]141    # entry next.  Build a popup for choices if there is more than
142    # one download element.
[201]143    #
[640]144    Rappture::Balloon $itk_component(hull).download \
[1077]145        -title "Choose what to [string tolower [Rappture::filexfer::label downloadWord]]:"
[640]146    set inner [$itk_component(hull).download component inner]
147
148    set i 0
[201]149    foreach comp [$_owner xml children -type download $path] {
[640]150        foreach dcomp [$_owner xml children -type from $path.$comp] {
151            set frompath [$_owner xml get $path.$comp.$dcomp]
152            if {"" != $frompath} {
153                lappend _dnpaths $frompath
154                set _dnpath2state($this-$frompath) [expr {$i == 0}]
155
156                set label [$_owner xml get $frompath.about.label]
157                checkbutton $inner.cb$i -text $label \
158                    -variable ::Rappture::Loader::_dnpath2state($this-$frompath)
159                pack $inner.cb$i -anchor w
160                incr i
161            }
[201]162        }
163    }
[1077]164    button $inner.go -text [Rappture::filexfer::label download] \
[640]165        -command [itcl::code $this _downloadValues]
166    pack $inner.go -side bottom -padx 50 -pady {4 2}
[201]167
[640]168    if {[llength $_dnpaths] > 0} {
[1077]169        $itk_component(combo) choices insert end \
170            @download [Rappture::filexfer::label download]
[640]171    }
172
[201]173    if {[$itk_component(combo) choices size] > 0} {
174        $itk_component(combo) choices insert end "---" "---"
175    }
176
177    #
[11]178    # Scan through and extract example objects, and load them into
179    # the combobox.
180    #
[13]181    set flist ""
[22]182    foreach comp [$_owner xml children -type example $path] {
183        lappend flist [$_owner xml get $path.$comp]
[13]184    }
185
186    # if there are no examples, then look for *.xml
187    if {[llength $flist] == 0} {
188        set flist *.xml
189    }
190
[201]191    catch {unset entries}
[120]192    set _counter 0
[13]193    foreach ftail $flist {
194        set fpath [file join $fdir examples $ftail]
[50]195
196        foreach fname [glob -nocomplain $fpath] {
[201]197            if {[string equal $fname $newfile]} {
198                continue
199            }
[11]200            if {[file exists $fname]} {
201                if {[catch {set obj [Rappture::library $fname]} result]} {
202                    puts stderr "WARNING: can't load example file \"$fname\""
203                    puts stderr "  $result"
204                } else {
205                    set label [$obj get about.label]
206                    if {$label == ""} {
[120]207                        set label "Example #[incr _counter]"
[11]208                    }
209
[1263]210                    # if this is new, add it to the label->file hash
[50]211                    if {![info exists entries($label)]} {
212                        set entries($label) $obj
[1225]213                        set _label2file($label) [file tail $fname]
[50]214                    }
[17]215
[50]216                    # translate default file name => default label
217                    if {[string equal $defval [file tail $fname]]} {
218                        $_owner xml put $path.default $label
[11]219                    }
220                }
221            } else {
222                puts stderr "WARNING: missing example file \"$fname\""
223            }
224        }
225    }
[201]226    foreach label [lsort -dictionary [array names entries]] {
227        $itk_component(combo) choices insert end $entries($label) $label
228    }
[11]229
[1225]230    set _copyfrom [$_owner xml get $path.copy.from]
231    set _copyto [$_owner xml get $path.copy.to]
232
[11]233    #
234    # Assign the default value to this widget, if there is one.
235    #
[22]236    set str [$_owner xml get $path.default]
[1253]237    if {$str != ""} { after 2500 [itcl::code $this value $str] }
[11]238}
239
240# ----------------------------------------------------------------------
[640]241# DESTRUCTOR
242# ----------------------------------------------------------------------
243itcl::body Rappture::Loader::destructor {} {
244    # be sure to clean up entries for this widget's download paths
245    foreach path $_dnpaths {
246        catch {unset _dnpath2state($this-$path)}
247    }
248}
249
250# ----------------------------------------------------------------------
[11]251# USAGE: value ?-check? ?<newval>?
252#
253# Clients use this to query/set the value for this widget.  With
254# no args, it returns the current value for the widget.  If the
255# <newval> is specified, it sets the value of the widget and
256# sends a <<Value>> event.  If the -check flag is included, the
257# new value is not actually applied, but just checked for correctness.
258# ----------------------------------------------------------------------
259itcl::body Rappture::Loader::value {args} {
260    set onlycheck 0
261    set i [lsearch -exact $args -check]
262    if {$i >= 0} {
263        set onlycheck 1
264        set args [lreplace $args $i $i]
265    }
266
267    if {[llength $args] == 1} {
268        if {$onlycheck} {
269            # someday we may add validation...
270            return
271        }
272        set newval [lindex $args 0]
273        $itk_component(combo) value $newval
274        return $newval
275
276    } elseif {[llength $args] != 0} {
277        error "wrong # args: should be \"value ?-check? ?newval?\""
278    }
279
280    #
281    # Query the value and return.
282    #
283    return [$itk_component(combo) value]
284}
285
286# ----------------------------------------------------------------------
287# USAGE: label
288#
289# Clients use this to query the label associated with this widget.
290# Reaches into the XML and pulls out the appropriate label string.
291# ----------------------------------------------------------------------
292itcl::body Rappture::Loader::label {} {
[22]293    set label [$_owner xml get $_path.about.label]
[11]294    if {"" == $label} {
295        set label "Example"
296    }
297    return $label
298}
299
300# ----------------------------------------------------------------------
301# USAGE: tooltip
302#
303# Clients use this to query the tooltip associated with this widget.
304# Reaches into the XML and pulls out the appropriate description
305# string.  Returns the string that should be used with the
306# Rappture::Tooltip facility.
307# ----------------------------------------------------------------------
308itcl::body Rappture::Loader::tooltip {} {
309    # query tooltip on-demand based on current choice
310    return "@[itcl::code $this _tooltip]"
311}
312
313# ----------------------------------------------------------------------
314# USAGE: _newValue
315#
316# Invoked automatically whenever the value in the combobox changes.
317# Tries to load the selected example into the tool's data structure.
318# Sends a <<Value>> event to notify clients of the change.
319# ----------------------------------------------------------------------
320itcl::body Rappture::Loader::_newValue {} {
321    set newval [$itk_component(combo) value]
322    set obj [$itk_component(combo) translate $newval]
[193]323    if {$obj == "@upload"} {
[1077]324        set tool [Rappture::Tool::resources -appname]
325        Rappture::filexfer::upload \
326            $tool $_uppath [itcl::code $this _uploadValue]
[201]327
328        # put the combobox back to its last value
329        $itk_component(combo) component entry configure -state normal
330        $itk_component(combo) component entry delete 0 end
331        $itk_component(combo) component entry insert end $_lastlabel
332        $itk_component(combo) component entry configure -state disabled
333
334    } elseif {$obj == "@download"} {
[640]335        if {[llength $_dnpaths] == 1} {
336            _downloadValues
[201]337        } else {
[640]338            $itk_component(hull).download activate $itk_component(combo) below
[201]339        }
340
341        # put the combobox back to its last value
342        $itk_component(combo) component entry configure -state normal
343        $itk_component(combo) component entry delete 0 end
344        $itk_component(combo) component entry insert end $_lastlabel
345        $itk_component(combo) component entry configure -state disabled
346
347    } elseif {$obj == "---"} {
348        # put the combobox back to its last value
349        $itk_component(combo) component entry configure -state normal
350        $itk_component(combo) component entry delete 0 end
351        $itk_component(combo) component entry insert end $_lastlabel
352        $itk_component(combo) component entry configure -state disabled
[193]353    } elseif {$obj != "" && $itk_option(-tool) != ""} {
[1225]354        if {("" != $_copyfrom) && ("" != $_copyto)} {
355            $obj copy $_copyto from $_copyfrom
356        }
357        $_owner xml put $_path.file $_label2file($newval)
[11]358        $itk_option(-tool) load $obj
[201]359        set _lastlabel $newval
[11]360    }
361
362    event generate $itk_component(hull) <<Value>>
363}
364
365# ----------------------------------------------------------------------
366# USAGE: _tooltip
367#
368# Returns the tooltip for this widget, given the current choice in
369# the selector.  This is normally called by the Rappture::Tooltip
370# facility whenever it is about to pop up a tooltip for this widget.
371# ----------------------------------------------------------------------
372itcl::body Rappture::Loader::_tooltip {} {
[22]373    set str [string trim [$_owner xml get $_path.about.description]]
[11]374
375    # get the description for the current choice, if there is one
376    set newval [$itk_component(combo) value]
377    set obj [$itk_component(combo) translate $newval]
378    if {$obj != ""} {
[193]379        if {$obj == "@upload"} {
380            append str "\n\nUse this option to upload data from your desktop."
381        } else {
382            set label [$obj get about.label]
[11]383            if {[string length $label] > 0} {
[193]384                append str "\n\n$label"
[11]385            }
[193]386
387            set desc [$obj get about.description]
388            if {[string length $desc] > 0} {
389                if {[string length $label] > 0} {
390                    append str ":\n"
391                } else {
392                    append str "\n\n"
393                }
394                append str $desc
395            }
[11]396        }
397    }
398    return [string trim $str]
399}
400
401# ----------------------------------------------------------------------
[681]402# USAGE: _uploadValue ?<key> <value> <key> <value> ...?
[193]403#
404# Invoked automatically whenever the user has uploaded data from
405# the "Upload..." option.  Takes the data value (passed as an
406# argument) and loads into the destination widget.
407# ----------------------------------------------------------------------
[681]408itcl::body Rappture::Loader::_uploadValue {args} {
[213]409    array set data $args
410
[640]411    if {[info exists data(error)]} {
412        Rappture::Tooltip::cue $itk_component(combo) $data(error)
413    }
414
[681]415    if {[info exists data(path)] && [info exists data(data)]} {
[640]416        Rappture::Tooltip::cue hide  ;# take down note about the popup window
[681]417        $itk_option(-tool) valuefor $data(path) $data(data)
[640]418
419        $itk_component(combo) component entry configure -state normal
420        $itk_component(combo) component entry delete 0 end
421        $itk_component(combo) component entry insert end "Uploaded data"
422        $itk_component(combo) component entry configure -state disabled
423        set _lastlabel "Uploaded data"
424    }
425}
426
427# ----------------------------------------------------------------------
428# USAGE: _downloadValues
429#
430# Used internally to download all values checked by the popup that
431# controls downloading.  Sends the values for the various controls
432# out to the user by popping up separate browser windows.
433# ----------------------------------------------------------------------
434itcl::body Rappture::Loader::_downloadValues {} {
435    # take down the popup (in case it was posted)
436    $itk_component(hull).download deactivate
437
438    set mesg ""
[1077]439    foreach path $_dnpaths {
440        if {$_dnpath2state($this-$path)} {
441            set info [$itk_option(-tool) valuefor $path]
442            set mesg [Rappture::filexfer::download $info input.txt]
443            if {"" != $mesg} { break }
[213]444        }
445    }
446
[640]447    if {"" != $mesg} {
448        Rappture::Tooltip::cue $itk_component(combo) $mesg
449    }
[193]450}
451
452# ----------------------------------------------------------------------
[11]453# OPTION: -tool
454# ----------------------------------------------------------------------
455itcl::configbody Rappture::Loader::tool {
456    if {[catch {$itk_option(-tool) isa Rappture::Tool} valid] || !$valid} {
457        error "object \"$itk_option(-tool)\" is not a Rappture Tool"
458    }
459}
[437]460
461# ----------------------------------------------------------------------
462# CONFIGURATION OPTION: -state
463# ----------------------------------------------------------------------
464itcl::configbody Rappture::Loader::state {
465    set valid {normal disabled}
466    if {[lsearch -exact $valid $itk_option(-state)] < 0} {
467        error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
468    }
469    $itk_component(combo) configure -state $itk_option(-state)
470}
Note: See TracBrowser for help on using the repository browser.