# ---------------------------------------------------------------------- # COMPONENT: loader - widget for loading examples and old runs # # This widget is a glorified combobox that is used to load various # example files into the application. # ====================================================================== # AUTHOR: Michael McLennan, Purdue University # Copyright (c) 2004-2005 Purdue Research Foundation # # See the file "license.terms" for information on usage and # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ====================================================================== package require Itk option add *Loader.textForeground black widgetDefault option add *Loader.textBackground white widgetDefault itcl::class Rappture::Loader { inherit itk::Widget itk_option define -tool tool Tool "" itk_option define -state state State "normal" constructor {owner path args} { # defined below } destructor { # defined below } public method value {args} public method label {} public method tooltip {} protected method _newValue {} protected method _uploadValue {path args} protected method _downloadValues {} protected method _tooltip {} private variable _owner "" ;# thing managing this control private variable _path "" ;# path in XML to this loader private variable _lastlabel "";# label of last example loaded private variable _uppath "" ;# list: path label desc ... private variable _dnpaths "" ;# list of download element paths private common _dnpath2state ;# maps download path => yes/no state private variable _copyfrom "" ;# copy xml objects from here in example lib private variable _copyto "" ;# copy xml objects here in example lib private variable _label2file ;# maps combobox labels to filenames } itk::usual Loader { keep -cursor -font keep -foreground -background keep -textforeground -textbackground keep -selectbackground -selectforeground -selectborderwidth } # ---------------------------------------------------------------------- # CONSTRUCTOR # ---------------------------------------------------------------------- itcl::body Rappture::Loader::constructor {owner path args} { if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 || !$valid} { error "bad object \"$owner\": should be Rappture::ControlOwner" } set _owner $owner set _path $path itk_component add combo { Rappture::Combobox $itk_interior.combo -editable no } { usual keep -width } pack $itk_component(combo) -expand yes -fill both bind $itk_component(combo) <> [itcl::code $this _newValue] eval itk_initialize $args # example files are stored here if {$itk_option(-tool) != ""} { set fdir [$itk_option(-tool) installdir] } else { set fdir "." } set defval [$_owner xml get $path.default] # # If this loader has a section, then create that # entry first. # set newfile "" foreach comp [$_owner xml children -type new $path] { set name [$_owner xml get $path.$comp] set fname [file join $fdir examples $name] if {[file exists $fname]} { set newfile $fname if {[catch {set obj [Rappture::library $fname]} result]} { puts stderr "WARNING: can't load example file \"$fname\"" puts stderr " $result" } else { set label "New" $itk_component(combo) choices insert end $obj $label # if this is new, add it to the label->file hash if {![info exists entries($label)]} { set entries($label) $obj set _label2file($label) [file tail $fname] } # translate default file name => default label if {[string equal $defval [file tail $fname]]} { $_owner xml put $path.default "New" } } break } else { puts stderr "WARNING: missing example file \"$fname\"" } } # # If this loader has an section, then create that # entry next. # foreach comp [$_owner xml children -type upload $path] { foreach tcomp [$_owner xml children -type to $path.$comp] { set topath [$_owner xml get $path.$comp.$tcomp] set label [$_owner xml get $topath.about.label] set desc [$_owner xml get $topath.about.description] lappend _uppath $topath $label $desc } break } if {[llength $_uppath] > 0} { $itk_component(combo) choices insert end \ @upload [Rappture::filexfer::label upload] } # # If this loader has a section, then create that # entry next. Build a popup for choices if there is more than # one download element. # Rappture::Balloon $itk_component(hull).download \ -title "Choose what to [string tolower [Rappture::filexfer::label downloadWord]]:" set inner [$itk_component(hull).download component inner] set i 0 foreach comp [$_owner xml children -type download $path] { foreach dcomp [$_owner xml children -type from $path.$comp] { set frompath [$_owner xml get $path.$comp.$dcomp] if {"" != $frompath} { lappend _dnpaths $frompath set _dnpath2state($this-$frompath) [expr {$i == 0}] set label [$_owner xml get $frompath.about.label] checkbutton $inner.cb$i -text $label \ -variable ::Rappture::Loader::_dnpath2state($this-$frompath) pack $inner.cb$i -anchor w incr i } } } button $inner.go -text [Rappture::filexfer::label download] \ -command [itcl::code $this _downloadValues] pack $inner.go -side bottom -padx 50 -pady {4 2} if {[llength $_dnpaths] > 0} { $itk_component(combo) choices insert end \ @download [Rappture::filexfer::label download] } if {[$itk_component(combo) choices size] > 0} { $itk_component(combo) choices insert end "---" "---" } # # Scan through and extract example objects, and load them into # the combobox. # set flist "" foreach comp [$_owner xml children -type example $path] { lappend flist [$_owner xml get $path.$comp] } # if there are no examples, then look for *.xml if {[llength $flist] == 0} { set flist *.xml } catch {unset entries} set _counter 0 foreach ftail $flist { set fpath [file join $fdir examples $ftail] foreach fname [glob -nocomplain $fpath] { if {[string equal $fname $newfile]} { continue } if {[file exists $fname]} { if {[catch {set obj [Rappture::library $fname]} result]} { puts stderr "WARNING: can't load example file \"$fname\"" puts stderr " $result" } else { set label [$obj get about.label] if {$label == ""} { set label "Example #[incr _counter]" } # if this is new, add it to the label->file hash if {![info exists entries($label)]} { set entries($label) $obj set _label2file($label) [file tail $fname] } # translate default file name => default label if {[string equal $defval [file tail $fname]]} { $_owner xml put $path.default $label } } } else { puts stderr "WARNING: missing example file \"$fname\"" } } } foreach label [lsort -dictionary [array names entries]] { $itk_component(combo) choices insert end $entries($label) $label } set _copyfrom [$_owner xml get $path.copy.from] set _copyto [$_owner xml get $path.copy.to] # # Assign the default value to this widget, if there is one. # set str [$_owner xml get $path.default] if {$str != ""} { after 2500 [itcl::code $this value $str] } } # ---------------------------------------------------------------------- # DESTRUCTOR # ---------------------------------------------------------------------- itcl::body Rappture::Loader::destructor {} { # be sure to clean up entries for this widget's download paths foreach path $_dnpaths { catch {unset _dnpath2state($this-$path)} } } # ---------------------------------------------------------------------- # USAGE: value ?-check? ?? # # Clients use this to query/set the value for this widget. With # no args, it returns the current value for the widget. If the # is specified, it sets the value of the widget and # sends a <> event. If the -check flag is included, the # new value is not actually applied, but just checked for correctness. # ---------------------------------------------------------------------- itcl::body Rappture::Loader::value {args} { set onlycheck 0 set i [lsearch -exact $args -check] if {$i >= 0} { set onlycheck 1 set args [lreplace $args $i $i] } if {[llength $args] == 1} { if {$onlycheck} { # someday we may add validation... return } set newval [lindex $args 0] $itk_component(combo) value $newval return $newval } elseif {[llength $args] != 0} { error "wrong # args: should be \"value ?-check? ?newval?\"" } # # Query the value and return. # return [$itk_component(combo) value] } # ---------------------------------------------------------------------- # USAGE: label # # Clients use this to query the label associated with this widget. # Reaches into the XML and pulls out the appropriate label string. # ---------------------------------------------------------------------- itcl::body Rappture::Loader::label {} { set label [$_owner xml get $_path.about.label] if {"" == $label} { set label "Example" } return $label } # ---------------------------------------------------------------------- # USAGE: tooltip # # Clients use this to query the tooltip associated with this widget. # Reaches into the XML and pulls out the appropriate description # string. Returns the string that should be used with the # Rappture::Tooltip facility. # ---------------------------------------------------------------------- itcl::body Rappture::Loader::tooltip {} { # query tooltip on-demand based on current choice return "@[itcl::code $this _tooltip]" } # ---------------------------------------------------------------------- # USAGE: _newValue # # Invoked automatically whenever the value in the combobox changes. # Tries to load the selected example into the tool's data structure. # Sends a <> event to notify clients of the change. # ---------------------------------------------------------------------- itcl::body Rappture::Loader::_newValue {} { set newval [$itk_component(combo) value] set obj [$itk_component(combo) translate $newval] if {$obj == "@upload"} { set tool [Rappture::Tool::resources -appname] Rappture::filexfer::upload \ $tool $_uppath [itcl::code $this _uploadValue] # put the combobox back to its last value $itk_component(combo) component entry configure -state normal $itk_component(combo) component entry delete 0 end $itk_component(combo) component entry insert end $_lastlabel $itk_component(combo) component entry configure -state disabled } elseif {$obj == "@download"} { if {[llength $_dnpaths] == 1} { _downloadValues } else { $itk_component(hull).download activate $itk_component(combo) below } # put the combobox back to its last value $itk_component(combo) component entry configure -state normal $itk_component(combo) component entry delete 0 end $itk_component(combo) component entry insert end $_lastlabel $itk_component(combo) component entry configure -state disabled } elseif {$obj == "---"} { # put the combobox back to its last value $itk_component(combo) component entry configure -state normal $itk_component(combo) component entry delete 0 end $itk_component(combo) component entry insert end $_lastlabel $itk_component(combo) component entry configure -state disabled } elseif {$obj != "" && $itk_option(-tool) != ""} { if {("" != $_copyfrom) && ("" != $_copyto)} { $obj copy $_copyto from $_copyfrom } $_owner xml put $_path.file $_label2file($newval) $itk_option(-tool) load $obj set _lastlabel $newval } event generate $itk_component(hull) <> } # ---------------------------------------------------------------------- # USAGE: _tooltip # # Returns the tooltip for this widget, given the current choice in # the selector. This is normally called by the Rappture::Tooltip # facility whenever it is about to pop up a tooltip for this widget. # ---------------------------------------------------------------------- itcl::body Rappture::Loader::_tooltip {} { set str [string trim [$_owner xml get $_path.about.description]] # get the description for the current choice, if there is one set newval [$itk_component(combo) value] set obj [$itk_component(combo) translate $newval] if {$obj != ""} { if {$obj == "@upload"} { append str "\n\nUse this option to upload data from your desktop." } else { set label [$obj get about.label] if {[string length $label] > 0} { append str "\n\n$label" } set desc [$obj get about.description] if {[string length $desc] > 0} { if {[string length $label] > 0} { append str ":\n" } else { append str "\n\n" } append str $desc } } } return [string trim $str] } # ---------------------------------------------------------------------- # USAGE: _uploadValue ? ...? # # Invoked automatically whenever the user has uploaded data from # the "Upload..." option. Takes the data value (passed as an # argument) and loads into the destination widget. # ---------------------------------------------------------------------- itcl::body Rappture::Loader::_uploadValue {args} { array set data $args if {[info exists data(error)]} { Rappture::Tooltip::cue $itk_component(combo) $data(error) } if {[info exists data(path)] && [info exists data(data)]} { Rappture::Tooltip::cue hide ;# take down note about the popup window $itk_option(-tool) valuefor $data(path) $data(data) $itk_component(combo) component entry configure -state normal $itk_component(combo) component entry delete 0 end $itk_component(combo) component entry insert end "Uploaded data" $itk_component(combo) component entry configure -state disabled set _lastlabel "Uploaded data" } } # ---------------------------------------------------------------------- # USAGE: _downloadValues # # Used internally to download all values checked by the popup that # controls downloading. Sends the values for the various controls # out to the user by popping up separate browser windows. # ---------------------------------------------------------------------- itcl::body Rappture::Loader::_downloadValues {} { # take down the popup (in case it was posted) $itk_component(hull).download deactivate set mesg "" foreach path $_dnpaths { if {$_dnpath2state($this-$path)} { set info [$itk_option(-tool) valuefor $path] set mesg [Rappture::filexfer::download $info input.txt] if {"" != $mesg} { break } } } if {"" != $mesg} { Rappture::Tooltip::cue $itk_component(combo) $mesg } } # ---------------------------------------------------------------------- # OPTION: -tool # ---------------------------------------------------------------------- itcl::configbody Rappture::Loader::tool { if {[catch {$itk_option(-tool) isa Rappture::Tool} valid] || !$valid} { error "object \"$itk_option(-tool)\" is not a Rappture Tool" } } # ---------------------------------------------------------------------- # CONFIGURATION OPTION: -state # ---------------------------------------------------------------------- itcl::configbody Rappture::Loader::state { set valid {normal disabled} if {[lsearch -exact $valid $itk_option(-state)] < 0} { error "bad value \"$itk_option(-state)\": should be [join $valid {, }]" } $itk_component(combo) configure -state $itk_option(-state) }