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

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