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

Last change on this file since 1555 was 1424, checked in by gah, 15 years ago

check for bad upload path in loader

File size: 15.5 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 variable _owner ""    ;# thing managing this control
38    private variable _path ""     ;# path in XML to this loader
39    private variable _lastlabel "";# label of last example loaded
40
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
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
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# ----------------------------------------------------------------------
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"
62    }
63    set _owner $owner
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
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
85    #
86    # If this loader has a <new> section, then create that
87    # entry first.
88    #
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
96
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 {
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
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    #
125    foreach comp [$_owner xml children -type upload $path] {
126        foreach tcomp [$_owner xml children -type to $path.$comp] {
127            set topath [$_owner xml get $path.$comp.$tcomp]
128            if { [$_owner xml element -as id $topath] == "" } {
129                puts stderr \
130                    "unknown <upload> path \"$topath\": please fix tool.xml"
131                continue
132            }
133            set label [$_owner xml get $topath.about.label]
134            set desc [$_owner xml get $topath.about.description]
135            lappend _uppath $topath $label $desc
136        }
137        break
138    }
139    if {[llength $_uppath] > 0} {
140        $itk_component(combo) choices insert end \
141            @upload [Rappture::filexfer::label upload]
142    }
143
144    #
145    # If this loader has a <download> section, then create that
146    # entry next.  Build a popup for choices if there is more than
147    # one download element.
148    #
149    Rappture::Balloon $itk_component(hull).download \
150        -title "Choose what to [string tolower [Rappture::filexfer::label downloadWord]]:"
151    set inner [$itk_component(hull).download component inner]
152
153    set i 0
154    foreach comp [$_owner xml children -type download $path] {
155        foreach dcomp [$_owner xml children -type from $path.$comp] {
156            set frompath [$_owner xml get $path.$comp.$dcomp]
157            if {"" != $frompath} {
158                lappend _dnpaths $frompath
159                set _dnpath2state($this-$frompath) [expr {$i == 0}]
160
161                set label [$_owner xml get $frompath.about.label]
162                checkbutton $inner.cb$i -text $label \
163                    -variable ::Rappture::Loader::_dnpath2state($this-$frompath)
164                pack $inner.cb$i -anchor w
165                incr i
166            }
167        }
168    }
169    button $inner.go -text [Rappture::filexfer::label download] \
170        -command [itcl::code $this _downloadValues]
171    pack $inner.go -side bottom -padx 50 -pady {4 2}
172
173    if {[llength $_dnpaths] > 0} {
174        $itk_component(combo) choices insert end \
175            @download [Rappture::filexfer::label download]
176    }
177
178    if {[$itk_component(combo) choices size] > 0} {
179        $itk_component(combo) choices insert end "---" "---"
180    }
181
182    #
183    # Scan through and extract example objects, and load them into
184    # the combobox.
185    #
186    set flist ""
187    foreach comp [$_owner xml children -type example $path] {
188        lappend flist [$_owner xml get $path.$comp]
189    }
190
191    # if there are no examples, then look for *.xml
192    if {[llength $flist] == 0} {
193        set flist *.xml
194    }
195
196    catch {unset entries}
197    set _counter 0
198    foreach ftail $flist {
199        set fpath [file join $fdir examples $ftail]
200
201        foreach fname [glob -nocomplain $fpath] {
202            if {[string equal $fname $newfile]} {
203                continue
204            }
205            if {[file exists $fname]} {
206                if {[catch {set obj [Rappture::library $fname]} result]} {
207                    puts stderr "WARNING: can't load example file \"$fname\""
208                    puts stderr "  $result"
209                } else {
210                    set label [$obj get about.label]
211                    if {$label == ""} {
212                        set label "Example #[incr _counter]"
213                    }
214
215                    # if this is new, add it to the label->file hash
216                    if {![info exists entries($label)]} {
217                        set entries($label) $obj
218                        set _label2file($label) [file tail $fname]
219                    }
220
221                    # translate default file name => default label
222                    if {[string equal $defval [file tail $fname]]} {
223                        $_owner xml put $path.default $label
224                    }
225                }
226            } else {
227                puts stderr "WARNING: missing example file \"$fname\""
228            }
229        }
230    }
231    foreach label [lsort -dictionary [array names entries]] {
232        $itk_component(combo) choices insert end $entries($label) $label
233    }
234
235    set _copyfrom [$_owner xml get $path.copy.from]
236    set _copyto [$_owner xml get $path.copy.to]
237
238    #
239    # Assign the default value to this widget, if there is one.
240    #
241    set str [$_owner xml get $path.default]
242    if {$str != ""} { after 1500 [itcl::code $this value $str] }
243}
244
245# ----------------------------------------------------------------------
246# DESTRUCTOR
247# ----------------------------------------------------------------------
248itcl::body Rappture::Loader::destructor {} {
249    # be sure to clean up entries for this widget's download paths
250    foreach path $_dnpaths {
251        catch {unset _dnpath2state($this-$path)}
252    }
253}
254
255# ----------------------------------------------------------------------
256# USAGE: value ?-check? ?<newval>?
257#
258# Clients use this to query/set the value for this widget.  With
259# no args, it returns the current value for the widget.  If the
260# <newval> is specified, it sets the value of the widget and
261# sends a <<Value>> event.  If the -check flag is included, the
262# new value is not actually applied, but just checked for correctness.
263# ----------------------------------------------------------------------
264itcl::body Rappture::Loader::value {args} {
265    set onlycheck 0
266    set i [lsearch -exact $args -check]
267    if {$i >= 0} {
268        set onlycheck 1
269        set args [lreplace $args $i $i]
270    }
271
272    if {[llength $args] == 1} {
273        if {$onlycheck} {
274            # someday we may add validation...
275            return
276        }
277        set newval [lindex $args 0]
278        $itk_component(combo) value $newval
279        return $newval
280
281    } elseif {[llength $args] != 0} {
282        error "wrong # args: should be \"value ?-check? ?newval?\""
283    }
284
285    #
286    # Query the value and return.
287    #
288    return [$itk_component(combo) value]
289}
290
291# ----------------------------------------------------------------------
292# USAGE: label
293#
294# Clients use this to query the label associated with this widget.
295# Reaches into the XML and pulls out the appropriate label string.
296# ----------------------------------------------------------------------
297itcl::body Rappture::Loader::label {} {
298    set label [$_owner xml get $_path.about.label]
299    if {"" == $label} {
300        set label "Example"
301    }
302    return $label
303}
304
305# ----------------------------------------------------------------------
306# USAGE: tooltip
307#
308# Clients use this to query the tooltip associated with this widget.
309# Reaches into the XML and pulls out the appropriate description
310# string.  Returns the string that should be used with the
311# Rappture::Tooltip facility.
312# ----------------------------------------------------------------------
313itcl::body Rappture::Loader::tooltip {} {
314    # query tooltip on-demand based on current choice
315    return "@[itcl::code $this _tooltip]"
316}
317
318# ----------------------------------------------------------------------
319# USAGE: _newValue
320#
321# Invoked automatically whenever the value in the combobox changes.
322# Tries to load the selected example into the tool's data structure.
323# Sends a <<Value>> event to notify clients of the change.
324# ----------------------------------------------------------------------
325itcl::body Rappture::Loader::_newValue {} {
326    set newval [$itk_component(combo) value]
327    set obj [$itk_component(combo) translate $newval]
328    if {$obj == "@upload"} {
329        set tool [Rappture::Tool::resources -appname]
330        Rappture::filexfer::upload \
331            $tool $_uppath [itcl::code $this _uploadValue]
332
333        # put the combobox back to its last value
334        $itk_component(combo) component entry configure -state normal
335        $itk_component(combo) component entry delete 0 end
336        $itk_component(combo) component entry insert end $_lastlabel
337        $itk_component(combo) component entry configure -state disabled
338
339    } elseif {$obj == "@download"} {
340        if {[llength $_dnpaths] == 1} {
341            _downloadValues
342        } else {
343            $itk_component(hull).download activate $itk_component(combo) below
344        }
345
346        # put the combobox back to its last value
347        $itk_component(combo) component entry configure -state normal
348        $itk_component(combo) component entry delete 0 end
349        $itk_component(combo) component entry insert end $_lastlabel
350        $itk_component(combo) component entry configure -state disabled
351
352    } elseif {$obj == "---"} {
353        # put the combobox back to its last value
354        $itk_component(combo) component entry configure -state normal
355        $itk_component(combo) component entry delete 0 end
356        $itk_component(combo) component entry insert end $_lastlabel
357        $itk_component(combo) component entry configure -state disabled
358    } elseif {$obj != "" && $itk_option(-tool) != ""} {
359        if {("" != $_copyfrom) && ("" != $_copyto)} {
360            $obj copy $_copyto from $_copyfrom
361        }
362        $_owner xml put $_path.file $_label2file($newval)
363        $itk_option(-tool) load $obj
364        set _lastlabel $newval
365    }
366
367    event generate $itk_component(hull) <<Value>>
368}
369
370# ----------------------------------------------------------------------
371# USAGE: _tooltip
372#
373# Returns the tooltip for this widget, given the current choice in
374# the selector.  This is normally called by the Rappture::Tooltip
375# facility whenever it is about to pop up a tooltip for this widget.
376# ----------------------------------------------------------------------
377itcl::body Rappture::Loader::_tooltip {} {
378    set str [string trim [$_owner xml get $_path.about.description]]
379
380    # get the description for the current choice, if there is one
381    set newval [$itk_component(combo) value]
382    set obj [$itk_component(combo) translate $newval]
383    if {$obj != ""} {
384        if {$obj == "@upload"} {
385            append str "\n\nUse this option to upload data from your desktop."
386        } else {
387            set label [$obj get about.label]
388            if {[string length $label] > 0} {
389                append str "\n\n$label"
390            }
391
392            set desc [$obj get about.description]
393            if {[string length $desc] > 0} {
394                if {[string length $label] > 0} {
395                    append str ":\n"
396                } else {
397                    append str "\n\n"
398                }
399                append str $desc
400            }
401        }
402    }
403    return [string trim $str]
404}
405
406# ----------------------------------------------------------------------
407# USAGE: _uploadValue ?<key> <value> <key> <value> ...?
408#
409# Invoked automatically whenever the user has uploaded data from
410# the "Upload..." option.  Takes the data value (passed as an
411# argument) and loads into the destination widget.
412# ----------------------------------------------------------------------
413itcl::body Rappture::Loader::_uploadValue {args} {
414    array set data $args
415
416    if {[info exists data(error)]} {
417        Rappture::Tooltip::cue $itk_component(combo) $data(error)
418    }
419
420    if {[info exists data(path)] && [info exists data(data)]} {
421        Rappture::Tooltip::cue hide  ;# take down note about the popup window
422        $itk_option(-tool) valuefor $data(path) $data(data)
423
424        $itk_component(combo) component entry configure -state normal
425        $itk_component(combo) component entry delete 0 end
426        $itk_component(combo) component entry insert end "Uploaded data"
427        $itk_component(combo) component entry configure -state disabled
428        set _lastlabel "Uploaded data"
429    }
430}
431
432# ----------------------------------------------------------------------
433# USAGE: _downloadValues
434#
435# Used internally to download all values checked by the popup that
436# controls downloading.  Sends the values for the various controls
437# out to the user by popping up separate browser windows.
438# ----------------------------------------------------------------------
439itcl::body Rappture::Loader::_downloadValues {} {
440    # take down the popup (in case it was posted)
441    $itk_component(hull).download deactivate
442
443    set mesg ""
444    foreach path $_dnpaths {
445        if {$_dnpath2state($this-$path)} {
446            set info [$itk_option(-tool) valuefor $path]
447            set mesg [Rappture::filexfer::download $info input.txt]
448            if {"" != $mesg} { break }
449        }
450    }
451
452    if {"" != $mesg} {
453        Rappture::Tooltip::cue $itk_component(combo) $mesg
454    }
455}
456
457# ----------------------------------------------------------------------
458# OPTION: -tool
459# ----------------------------------------------------------------------
460itcl::configbody Rappture::Loader::tool {
461    if {[catch {$itk_option(-tool) isa Rappture::Tool} valid] || !$valid} {
462        error "object \"$itk_option(-tool)\" is not a Rappture Tool"
463    }
464}
465
466# ----------------------------------------------------------------------
467# CONFIGURATION OPTION: -state
468# ----------------------------------------------------------------------
469itcl::configbody Rappture::Loader::state {
470    set valid {normal disabled}
471    if {[lsearch -exact $valid $itk_option(-state)] < 0} {
472        error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
473    }
474    $itk_component(combo) configure -state $itk_option(-state)
475}
Note: See TracBrowser for help on using the repository browser.