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

Last change on this file since 1263 was 1263, checked in by dkearney, 16 years ago

fix for bug regarding loader where <new> option no longer loads the new file.

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