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

Last change on this file since 13 was 13, checked in by mmc, 16 years ago

Many improvements, including a new energy level viewer
for Huckel-IV. Added support for a new <boolean> type.
Fixed the cloud/field stuff so that when a cloud is 1D,
it reverts to BLT vectors so it will plot correctly.
Fixed the install script to work better on Windows.

File size: 7.7 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
9#  Purdue Research Foundation, West Lafayette, IN
10# ======================================================================
11package require Itk
12
13option add *Loader.textForeground black widgetDefault
14option add *Loader.textBackground white widgetDefault
15
16itcl::class Rappture::Loader {
17    inherit itk::Widget
18
19    itk_option define -tool tool Tool ""
20
21    constructor {xmlobj path args} { # defined below }
22
23    public method value {args}
24
25    public method label {}
26    public method tooltip {}
27
28    protected method _newValue {}
29    protected method _tooltip {}
30
31    private variable _xmlobj ""   ;# XML containing description
32    private variable _path ""     ;# path in XML to this loader
33}
34
35itk::usual Loader {
36    keep -cursor -font
37    keep -foreground -background
38    keep -textforeground -textbackground
39    keep -selectbackground -selectforeground -selectborderwidth
40}
41
42# ----------------------------------------------------------------------
43# CONSTRUCTOR
44# ----------------------------------------------------------------------
45itcl::body Rappture::Loader::constructor {xmlobj path args} {
46    if {![Rappture::library isvalid $xmlobj]} {
47        error "bad value \"$xmlobj\": should be Rappture::library"
48    }
49    set _xmlobj $xmlobj
50    set _path $path
51
52    itk_component add combo {
53        Rappture::Combobox $itk_interior.combo -editable no
54    } {
55        usual
56        keep -width
57    }
58    pack $itk_component(combo) -expand yes -fill both
59    bind $itk_component(combo) <<Value>> [itcl::code $this _newValue]
60
61    eval itk_initialize $args
62
63    #
64    # Scan through and extract example objects, and load them into
65    # the combobox.
66    #
67    set defval [$xmlobj get $path.default]
68
69    set flist ""
70    foreach comp [$xmlobj children -type example $path] {
71        lappend flist [$xmlobj get $path.$comp]
72    }
73
74    # if there are no examples, then look for *.xml
75    if {[llength $flist] == 0} {
76        set flist *.xml
77    }
78
79    if {$itk_option(-tool) != ""} {
80        set fdir [$itk_option(-tool) installdir]
81    } else {
82        set fdir "."
83    }
84
85    set _counter 1
86    foreach ftail $flist {
87        set fpath [file join $fdir examples $ftail]
88        foreach fname [glob -nocomplain $fpath] {
89            if {[file exists $fname]} {
90                if {[catch {set obj [Rappture::library $fname]} result]} {
91                    puts stderr "WARNING: can't load example file \"$fname\""
92                    puts stderr "  $result"
93                } else {
94                    set label [$obj get about.label]
95                    if {$label == ""} {
96                        set label "Example #$_counter"
97                    }
98                    $itk_component(combo) choices insert end $obj $label
99
100                    if {[string equal $defval [file tail $fname]]} {
101                        $xmlobj put $path.default $label
102                    }
103                }
104            } else {
105                puts stderr "WARNING: missing example file \"$fname\""
106            }
107        }
108    }
109
110    #
111    # Assign the default value to this widget, if there is one.
112    #
113    set str [$xmlobj get $path.default]
114    if {$str != ""} { after 500 [itcl::code $this value $str] }
115}
116
117# ----------------------------------------------------------------------
118# USAGE: value ?-check? ?<newval>?
119#
120# Clients use this to query/set the value for this widget.  With
121# no args, it returns the current value for the widget.  If the
122# <newval> is specified, it sets the value of the widget and
123# sends a <<Value>> event.  If the -check flag is included, the
124# new value is not actually applied, but just checked for correctness.
125# ----------------------------------------------------------------------
126itcl::body Rappture::Loader::value {args} {
127    set onlycheck 0
128    set i [lsearch -exact $args -check]
129    if {$i >= 0} {
130        set onlycheck 1
131        set args [lreplace $args $i $i]
132    }
133
134    if {[llength $args] == 1} {
135        if {$onlycheck} {
136            # someday we may add validation...
137            return
138        }
139        set newval [lindex $args 0]
140        $itk_component(combo) value $newval
141        return $newval
142
143    } elseif {[llength $args] != 0} {
144        error "wrong # args: should be \"value ?-check? ?newval?\""
145    }
146
147    #
148    # Query the value and return.
149    #
150    return [$itk_component(combo) value]
151}
152
153# ----------------------------------------------------------------------
154# USAGE: label
155#
156# Clients use this to query the label associated with this widget.
157# Reaches into the XML and pulls out the appropriate label string.
158# ----------------------------------------------------------------------
159itcl::body Rappture::Loader::label {} {
160    set label [$_xmlobj get $_path.about.label]
161    if {"" == $label} {
162        set label "Example"
163    }
164    return $label
165}
166
167# ----------------------------------------------------------------------
168# USAGE: tooltip
169#
170# Clients use this to query the tooltip associated with this widget.
171# Reaches into the XML and pulls out the appropriate description
172# string.  Returns the string that should be used with the
173# Rappture::Tooltip facility.
174# ----------------------------------------------------------------------
175itcl::body Rappture::Loader::tooltip {} {
176    # query tooltip on-demand based on current choice
177    return "@[itcl::code $this _tooltip]"
178}
179
180# ----------------------------------------------------------------------
181# USAGE: _newValue
182#
183# Invoked automatically whenever the value in the combobox changes.
184# Tries to load the selected example into the tool's data structure.
185# Sends a <<Value>> event to notify clients of the change.
186# ----------------------------------------------------------------------
187itcl::body Rappture::Loader::_newValue {} {
188    set newval [$itk_component(combo) value]
189    set obj [$itk_component(combo) translate $newval]
190    if {$obj != "" && $itk_option(-tool) != ""} {
191        $itk_option(-tool) load $obj
192    }
193
194    event generate $itk_component(hull) <<Value>>
195}
196
197# ----------------------------------------------------------------------
198# USAGE: _tooltip
199#
200# Returns the tooltip for this widget, given the current choice in
201# the selector.  This is normally called by the Rappture::Tooltip
202# facility whenever it is about to pop up a tooltip for this widget.
203# ----------------------------------------------------------------------
204itcl::body Rappture::Loader::_tooltip {} {
205    set str [string trim [$_xmlobj get $_path.about.description]]
206
207    # get the description for the current choice, if there is one
208    set newval [$itk_component(combo) value]
209    set obj [$itk_component(combo) translate $newval]
210    if {$obj != ""} {
211        set label [$obj get about.label]
212        if {[string length $label] > 0} {
213            append str "\n\n$label"
214        }
215
216        set desc [$obj get about.description]
217        if {[string length $desc] > 0} {
218            if {[string length $label] > 0} {
219                append str ":\n"
220            } else {
221                append str "\n\n"
222            }
223            append str $desc
224        }
225    }
226    return [string trim $str]
227}
228
229# ----------------------------------------------------------------------
230# OPTION: -tool
231# ----------------------------------------------------------------------
232itcl::configbody Rappture::Loader::tool {
233    if {[catch {$itk_option(-tool) isa Rappture::Tool} valid] || !$valid} {
234        error "object \"$itk_option(-tool)\" is not a Rappture Tool"
235    }
236}
Note: See TracBrowser for help on using the repository browser.