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

Last change on this file was 6714, checked in by clarksm, 4 years ago

Make sure all phases/pages get initialized before processing loaders.
There was a problem when new elements were introduced in loader files.
The arbitrary sleep was not long enough.
File size: 19.1 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#                   puts stderr "::load example file = $fname"
217                    set label [$obj get about.label]
218                    if {$label == ""} {
219                        set label "Example #[incr _counter]"
220                    }
221
222                    # if this is new, add it to the label->file hash
223                    if {![info exists entries($label)]} {
224                        set entries($label) $obj
225                        set _label2file($label) [file tail $fname]
226                    }
227
228                    # translate default file name => default label
229                    if {[string equal $defval [file tail $fname]]} {
230#                       puts stderr "::load set default file = $fname"
231                        $_owner xml put $path.default $label
232                    }
233                }
234            } else {
235                puts stderr "WARNING: missing example file \"$fname\""
236            }
237        }
238    }
239    foreach label [lsort -dictionary [array names entries]] {
240        $itk_component(combo) choices insert end $entries($label) $label
241    }
242
243    set _copyfrom [string trim [$_owner xml get $path.copy.from]]
244    set _copyto   [string trim [$_owner xml get $path.copy.to]]
245
246    #
247    # Assign the default value to this widget, if there is one.
248    #
249    set str [string trim [$_owner xml get $path.default]]
250    if { $str != "" } {
251        EventuallySetDefaultValue $str
252    }
253}
254
255# ----------------------------------------------------------------------
256# DESTRUCTOR
257# ----------------------------------------------------------------------
258itcl::body Rappture::Loader::destructor {} {
259    # be sure to clean up entries for this widget's download paths
260    foreach path $_dnpaths {
261        catch {unset _dnpath2state($this-$path)}
262    }
263}
264
265# ----------------------------------------------------------------------
266# USAGE: value ?-check? ?<newval>?
267#
268# Clients use this to query/set the value for this widget.  With
269# no args, it returns the current value for the widget.  If the
270# <newval> is specified, it sets the value of the widget and
271# sends a <<Value>> event.  If the -check flag is included, the
272# new value is not actually applied, but just checked for correctness.
273# ----------------------------------------------------------------------
274itcl::body Rappture::Loader::value {args} {
275    set onlycheck 0
276    set i [lsearch -exact $args -check]
277    if {$i >= 0} {
278        set onlycheck 1
279        set args [lreplace $args $i $i]
280    }
281
282    if {[llength $args] == 1} {
283        if {$onlycheck} {
284            # someday we may add validation...
285            return
286        }
287        set newval [lindex $args 0]
288        $itk_component(combo) value $newval
289        return $newval
290    } elseif {[llength $args] != 0} {
291        error "wrong # args: should be \"value ?-check? ?newval?\""
292    }
293
294    #
295    # Query the value and return.
296    #
297    return [$itk_component(combo) value]
298}
299
300# ----------------------------------------------------------------------
301# USAGE: label
302#
303# Clients use this to query the label associated with this widget.
304# Reaches into the XML and pulls out the appropriate label string.
305# ----------------------------------------------------------------------
306itcl::body Rappture::Loader::label {} {
307    set label [string trim [$_owner xml get $_path.about.label]]
308    if {"" == $label} {
309        set label "Example"
310    }
311    return $label
312}
313
314# ----------------------------------------------------------------------
315# USAGE: tooltip
316#
317# Clients use this to query the tooltip associated with this widget.
318# Reaches into the XML and pulls out the appropriate description
319# string.  Returns the string that should be used with the
320# Rappture::Tooltip facility.
321# ----------------------------------------------------------------------
322itcl::body Rappture::Loader::tooltip {} {
323    # query tooltip on-demand based on current choice
324    return "@[itcl::code $this _tooltip]"
325}
326
327itcl::body Rappture::Loader::SetDefaultValue { value } {
328#   puts stderr "Rappture::Loader::SetDefaultValue $value"
329    $itk_component(combo) value $value
330    _newValue
331}
332#
333#
334# EventuallySetDefaultValue --
335#
336#   Sets the designated default value for the loader.  This must be done
337#   after the entire application is assembled, otherwise the default values
338#   set up by the loader will be overwritten by the various widgets
339#   themselves when they try to set their default values.
340#
341itcl::body Rappture::Loader::EventuallySetDefaultValue { value } {
342    global env
343    if { [info exists env(RAPPTURE_PHASES_LOADED)] } {
344        set setDefaultValueNow $env(RAPPTURE_PHASES_LOADED)
345    } else {
346        set setDefaultValueNow 2
347    }
348
349#   puts stderr "Rappture::Loader::EventuallySetDefaultValue  $setDefaultValueNow"
350
351    if {$setDefaultValueNow == 0} {
352        after 100 [itcl::code $this EventuallySetDefaultValue $value]
353    } else {
354        [itcl::code $this SetDefaultValue $value]
355    }
356}
357
358# ----------------------------------------------------------------------
359# USAGE: _newValue
360#
361# Invoked automatically whenever the value in the combobox changes.
362# Tries to load the selected example into the tool's data structure.
363# Sends a <<Value>> event to notify clients of the change.
364# ----------------------------------------------------------------------
365itcl::body Rappture::Loader::_newValue {} {
366    set newval [$itk_component(combo) value]
367    set obj [$itk_component(combo) translate $newval]
368#   puts stderr "loader::_newValue $obj  $itk_option(-tool)"
369    if {$obj == "@upload"} {
370        set tool [Rappture::Tool::resources -appname]
371        Rappture::filexfer::upload \
372            $tool $_uppath [itcl::code $this _uploadValue]
373
374        # put the combobox back to its last value
375        $itk_component(combo) component entry configure -state normal
376        $itk_component(combo) component entry delete 0 end
377        $itk_component(combo) component entry insert end $_lastlabel
378        $itk_component(combo) component entry configure -state disabled
379
380    } elseif {$obj == "@download"} {
381        if {[llength $_dnpaths] == 1} {
382            _downloadValues
383        } else {
384            $itk_component(hull).download activate $itk_component(combo) below
385        }
386
387        # put the combobox back to its last value
388        $itk_component(combo) component entry configure -state normal
389        $itk_component(combo) component entry delete 0 end
390        $itk_component(combo) component entry insert end $_lastlabel
391        $itk_component(combo) component entry configure -state disabled
392
393    } elseif {$obj == "---"} {
394        # put the combobox back to its last value
395        $itk_component(combo) component entry configure -state normal
396        $itk_component(combo) component entry delete 0 end
397        $itk_component(combo) component entry insert end $_lastlabel
398        $itk_component(combo) component entry configure -state disabled
399    } elseif {$obj != "" && $itk_option(-tool) != ""} {
400        if {("" != $_copyfrom) && ("" != $_copyto)} {
401            $obj copy $_copyto from $_copyfrom
402        }
403#       puts stderr "loader::_newValue $newval $_label2file($newval)"
404        $_owner xml put $_path.file $_label2file($newval)
405        $itk_option(-tool) load $obj
406        set _lastlabel $newval
407    }
408
409    event generate $itk_component(hull) <<Value>>
410}
411
412# ----------------------------------------------------------------------
413# USAGE: _tooltip
414#
415# Returns the tooltip for this widget, given the current choice in
416# the selector.  This is normally called by the Rappture::Tooltip
417# facility whenever it is about to pop up a tooltip for this widget.
418# ----------------------------------------------------------------------
419itcl::body Rappture::Loader::_tooltip {} {
420    set str [string trim [$_owner xml get $_path.about.description]]
421
422    # get the description for the current choice, if there is one
423    set newval [$itk_component(combo) value]
424    set obj [$itk_component(combo) translate $newval]
425    if {$obj != ""} {
426        if {$obj == "@upload"} {
427            append str "\n\nUse this option to upload data from your desktop."
428        } else {
429            set label [$obj get about.label]
430            if {[string length $label] > 0} {
431                append str "\n\n$label"
432            }
433
434            set desc [$obj get about.description]
435            if {[string length $desc] > 0} {
436                if {[string length $label] > 0} {
437                    append str ":\n"
438                } else {
439                    append str "\n\n"
440                }
441                append str $desc
442            }
443        }
444    }
445    return [string trim $str]
446}
447
448# ----------------------------------------------------------------------
449# USAGE: _log
450#
451# Used internally to send info to the logging mechanism.  Calls the
452# Rappture::Logger mechanism to log the change to this input.
453# ----------------------------------------------------------------------
454itcl::body Rappture::Loader::_log {} {
455    Rappture::Logger::log input $_path [$itk_component(combo) value]
456}
457
458# ----------------------------------------------------------------------
459# USAGE: _uploadValue ?<key> <value> <key> <value> ...?
460#
461# Invoked automatically whenever the user has uploaded data from
462# the "Upload..." option.  Takes the data value (passed as an
463# argument) and loads into the destination widget.
464# ----------------------------------------------------------------------
465itcl::body Rappture::Loader::_uploadValue {args} {
466    array set data $args
467
468    if {[info exists data(error)]} {
469        Rappture::Tooltip::cue $itk_component(combo) $data(error)
470    }
471
472    if {[info exists data(path)] && [info exists data(data)]} {
473        Rappture::Tooltip::cue hide  ;# take down note about the popup window
474        $itk_option(-tool) valuefor $data(path) $data(data)
475
476        $itk_component(combo) component entry configure -state normal
477        $itk_component(combo) component entry delete 0 end
478        $itk_component(combo) component entry insert end "Uploaded data"
479        $itk_component(combo) component entry configure -state disabled
480        set _lastlabel "Uploaded data"
481    }
482}
483
484# ----------------------------------------------------------------------
485# USAGE: _downloadValues
486#
487# Used internally to download all values checked by the popup that
488# controls downloading.  Sends the values for the various controls
489# out to the user by popping up separate browser windows.
490# ----------------------------------------------------------------------
491itcl::body Rappture::Loader::_downloadValues {} {
492    # take down the popup (in case it was posted)
493    $itk_component(hull).download deactivate
494
495    set mesg ""
496    foreach path $_dnpaths {
497        if {$_dnpath2state($this-$path)} {
498            set info [$itk_option(-tool) valuefor $path]
499            set mesg [Rappture::filexfer::download $info input.txt]
500            if {"" != $mesg} { break }
501        }
502    }
503
504    if {"" != $mesg} {
505        Rappture::Tooltip::cue $itk_component(combo) $mesg
506    }
507}
508
509# ----------------------------------------------------------------------
510# OPTION: -tool
511# ----------------------------------------------------------------------
512itcl::configbody Rappture::Loader::tool {
513    if {[catch {$itk_option(-tool) isa Rappture::Tool} valid] || !$valid} {
514        error "object \"$itk_option(-tool)\" is not a Rappture Tool"
515    }
516}
517
518# ----------------------------------------------------------------------
519# CONFIGURATION OPTION: -state
520# ----------------------------------------------------------------------
521itcl::configbody Rappture::Loader::state {
522    set valid {normal disabled}
523    if {[lsearch -exact $valid $itk_option(-state)] < 0} {
524        error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
525    }
526    $itk_component(combo) configure -state $itk_option(-state)
527}
Note: See TracBrowser for help on using the repository browser.