source: branches/1.6/gui/scripts/loader.tcl @ 6311

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

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

File size: 18.3 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#
333#   This is called from a <Map> event to the loader (combobox).  This will
334#   get trigger the first time the loader is displayed.  The binding is
335#   then removed.
336#
337itcl::body Rappture::Loader::SetDefaultValue { value } {
338    after 100 [itcl::code $this value $value]
339}
340
341# ----------------------------------------------------------------------
342# USAGE: _newValue
343#
344# Invoked automatically whenever the value in the combobox changes.
345# Tries to load the selected example into the tool's data structure.
346# Sends a <<Value>> event to notify clients of the change.
347# ----------------------------------------------------------------------
348itcl::body Rappture::Loader::_newValue {} {
349    set newval [$itk_component(combo) value]
350    set obj [$itk_component(combo) translate $newval]
351    if {$obj == "@upload"} {
352        set tool [Rappture::Tool::resources -appname]
353        Rappture::filexfer::upload \
354            $tool $_uppath [itcl::code $this _uploadValue]
355
356        # put the combobox back to its last value
357        $itk_component(combo) component entry configure -state normal
358        $itk_component(combo) component entry delete 0 end
359        $itk_component(combo) component entry insert end $_lastlabel
360        $itk_component(combo) component entry configure -state disabled
361
362    } elseif {$obj == "@download"} {
363        if {[llength $_dnpaths] == 1} {
364            _downloadValues
365        } else {
366            $itk_component(hull).download activate $itk_component(combo) below
367        }
368
369        # put the combobox back to its last value
370        $itk_component(combo) component entry configure -state normal
371        $itk_component(combo) component entry delete 0 end
372        $itk_component(combo) component entry insert end $_lastlabel
373        $itk_component(combo) component entry configure -state disabled
374
375    } elseif {$obj == "---"} {
376        # put the combobox back to its last value
377        $itk_component(combo) component entry configure -state normal
378        $itk_component(combo) component entry delete 0 end
379        $itk_component(combo) component entry insert end $_lastlabel
380        $itk_component(combo) component entry configure -state disabled
381    } elseif {$obj != "" && $itk_option(-tool) != ""} {
382        if {("" != $_copyfrom) && ("" != $_copyto)} {
383            $obj copy $_copyto from $_copyfrom
384        }
385        $_owner xml put $_path.file $_label2file($newval)
386        $itk_option(-tool) load $obj
387        set _lastlabel $newval
388    }
389
390    event generate $itk_component(hull) <<Value>>
391}
392
393# ----------------------------------------------------------------------
394# USAGE: _tooltip
395#
396# Returns the tooltip for this widget, given the current choice in
397# the selector.  This is normally called by the Rappture::Tooltip
398# facility whenever it is about to pop up a tooltip for this widget.
399# ----------------------------------------------------------------------
400itcl::body Rappture::Loader::_tooltip {} {
401    set str [string trim [$_owner xml get $_path.about.description]]
402
403    # get the description for the current choice, if there is one
404    set newval [$itk_component(combo) value]
405    set obj [$itk_component(combo) translate $newval]
406    if {$obj != ""} {
407        if {$obj == "@upload"} {
408            append str "\n\nUse this option to upload data from your desktop."
409        } else {
410            set label [$obj get about.label]
411            if {[string length $label] > 0} {
412                append str "\n\n$label"
413            }
414
415            set desc [$obj get about.description]
416            if {[string length $desc] > 0} {
417                if {[string length $label] > 0} {
418                    append str ":\n"
419                } else {
420                    append str "\n\n"
421                }
422                append str $desc
423            }
424        }
425    }
426    return [string trim $str]
427}
428
429# ----------------------------------------------------------------------
430# USAGE: _log
431#
432# Used internally to send info to the logging mechanism.  Calls the
433# Rappture::Logger mechanism to log the change to this input.
434# ----------------------------------------------------------------------
435itcl::body Rappture::Loader::_log {} {
436    Rappture::Logger::log input $_path [$itk_component(combo) value]
437}
438
439# ----------------------------------------------------------------------
440# USAGE: _uploadValue ?<key> <value> <key> <value> ...?
441#
442# Invoked automatically whenever the user has uploaded data from
443# the "Upload..." option.  Takes the data value (passed as an
444# argument) and loads into the destination widget.
445# ----------------------------------------------------------------------
446itcl::body Rappture::Loader::_uploadValue {args} {
447    array set data $args
448
449    if {[info exists data(error)]} {
450        Rappture::Tooltip::cue $itk_component(combo) $data(error)
451    }
452
453    if {[info exists data(path)] && [info exists data(data)]} {
454        Rappture::Tooltip::cue hide  ;# take down note about the popup window
455        $itk_option(-tool) valuefor $data(path) $data(data)
456
457        $itk_component(combo) component entry configure -state normal
458        $itk_component(combo) component entry delete 0 end
459        $itk_component(combo) component entry insert end "Uploaded data"
460        $itk_component(combo) component entry configure -state disabled
461        set _lastlabel "Uploaded data"
462    }
463}
464
465# ----------------------------------------------------------------------
466# USAGE: _downloadValues
467#
468# Used internally to download all values checked by the popup that
469# controls downloading.  Sends the values for the various controls
470# out to the user by popping up separate browser windows.
471# ----------------------------------------------------------------------
472itcl::body Rappture::Loader::_downloadValues {} {
473    # take down the popup (in case it was posted)
474    $itk_component(hull).download deactivate
475
476    set mesg ""
477    foreach path $_dnpaths {
478        if {$_dnpath2state($this-$path)} {
479            set info [$itk_option(-tool) valuefor $path]
480            set mesg [Rappture::filexfer::download $info input.txt]
481            if {"" != $mesg} { break }
482        }
483    }
484
485    if {"" != $mesg} {
486        Rappture::Tooltip::cue $itk_component(combo) $mesg
487    }
488}
489
490# ----------------------------------------------------------------------
491# OPTION: -tool
492# ----------------------------------------------------------------------
493itcl::configbody Rappture::Loader::tool {
494    if {[catch {$itk_option(-tool) isa Rappture::Tool} valid] || !$valid} {
495        error "object \"$itk_option(-tool)\" is not a Rappture Tool"
496    }
497}
498
499# ----------------------------------------------------------------------
500# CONFIGURATION OPTION: -state
501# ----------------------------------------------------------------------
502itcl::configbody Rappture::Loader::state {
503    set valid {normal disabled}
504    if {[lsearch -exact $valid $itk_option(-state)] < 0} {
505        error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
506    }
507    $itk_component(combo) configure -state $itk_option(-state)
508}
Note: See TracBrowser for help on using the repository browser.