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

Last change on this file since 1253 was 1253, checked in by dkearney, 14 years ago

upping the dalay for loaders so apps like photonicsrt can take advantage of multiple layers which are properly configured. without the delay, the newValue function is never called, i think because the gui is still being setup when the call is scheduled to be made. by the time the gui is setup, the delay has passed

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