source: branches/1.7/gui/scripts/loader.tcl @ 6313

Last change on this file since 6313 was 6313, checked in by gah, 8 years ago

fixes for binary data in putFile, defer loader setting default value

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