source: trunk/gui/scripts/loader.tcl

Last change on this file was 6473, checked in by ldelgass, 8 years ago

Merge simsets, result cache (instant-on) from release branches.

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