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

Last change on this file since 1695 was 1694, checked in by dkearney, 15 years ago

spacing, tabs, blahh

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