1 # xml-to-ui.tcl --
2 #
3 # generates UIs from XML descriptions
4 #
5 # Copyright (c) 1998-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30
31
32 import Trace PowerSwitchUI UDPChannel XMLParser
33 import CheckButton EntryObj ScaleObj RadioButtonsObj
34
35 #Trace on ; Trace add UIGenerator
36
37 #
38 # generates UIs from XML descriptions <p>
39 #
40 # XML DTD accepted by this file described in the tech report: <br>
41 #
42 # ``Enabling Smart Spaces: Entity Description and User Interface
43 # Generation for a Heterogeneous Component-based Distributed System'' <p>
44 #
45 # available on http://www.cs.berkeley.edu/~hodes/research.html
46 #
47 # It is also listed here, but will be munged in a HTML browser....
48 #
49 #<pre>
50 #
51 #<!ELEMENT object (label?, addrspec?, ui*,
52 # method*, object*)>
53 #<!ATTLIST object
54 # name CDATA #REQUIRED>
55 #<!ELEMENT method (param*)>
56 #<!ATTLIST method
57 # name CDATA #REQUIRED>
58 #<!ELEMENT param (#PCDATA)>
59 #<!ATTLIST param
60 # name CDATA #REQUIRED
61 # lexType (int | real | boolean | enum
62 # | string | ...) 'string'
63 # optional #BOOLEAN>
64 #<!ELEMENT label (#PCDATA)>
65 #<!ELEMENT addrspec (#PCDATA)>
66 #<!ELEMENT ui (#PCDATA)>
67 #
68 #</pre>
69 #
70 Class UIGenerator
71
72 #
73 UIGenerator public init {args} {
74
75 # FIXME test harness only -- shouldn't be called with args
76 set cnt 0
77 foreach f $args {
78 puts "parsing `$f'"
79 frame .f$cnt
80 $self GenerateUIfromFile $f .f$cnt
81 pack .f$cnt -side right
82 #$self print
83 incr cnt
84 }
85 }
86
87 # generates a UI from file <i>filename</i> and packs the result
88 # into window/frame <i>w</i>. If any agents were allocated (via "new")
89 # due to <UI> elements in the XML, return a list of them.
90 #
91 UIGenerator public GenerateUIfromFile {filename w} {
92 $self instvar parseResults_ allocatedObjects_
93
94 set f [open $filename r]
95 set x [read $f]
96 set parseResults_ [XML::parse $x]
97 Trc $class "[XML::pretty_print $parseResults_]"
98
99 $self GenerateUIFromXML $parseResults_ $w
100
101 close $f
102 Trc $class "done generating."
103 if [info exists allocatedObjects_] {
104 set o $allocatedObjects_
105 Trc $class "allocated Objects = $o"
106 unset allocatedObjects_
107 return $o
108 }
109 }
110
111 # take a single XML "object" description and dynamically generate a
112 # corresponding UIAgent
113 UIGenerator public GenerateUIFromXML {parsedXMLlist w} {
114 $self instvar txt_ allocatedObjects_
115
116 $self FlattenXML $parsedXMLlist
117
118 foreach i [lsort [array names txt_]] {
119 set obj [lindex [split $i ,] 0]
120 set fr $w$obj
121 if {[info commands $fr] == ""} {
122 frame $fr -relief groove
123 label $fr.l -text [lindex $txt_($obj,LABEL) 0]
124 pack $fr -side left -expand 1
125 pack $fr.l
126 if {[llength [split $obj .]] == 2} {
127 $fr.l configure -font "*-15-*"
128 }
129 if {[info exists txt_($obj,UI)] && \
130 [lindex $txt_($obj,UI) 0] == "LANG mash"} {
131 # $self getUIAndStartinFrame $fr FIXME
132 # FIXME - instead, for now, assumes have UI local & imported
133 Trc $class "new [lindex $txt_($obj,UI) 1] \
134 $fr $txt_($obj,ADDRPORT)"
135 set o [new [lindex $txt_($obj,UI) 1] $fr $txt_($obj,ADDRPORT)]
136 lappend allocatedObjects_ $o
137 } else {
138 if {[array names txt_ $obj,METHODS] != ""} {
139 $self buildUIfromMethodList $fr \
140 [list $txt_($obj,METHODS)] $txt_($obj,ADDRPORT)
141 }
142 }
143 }
144 }
145 unset txt_
146 }
147
148 #
149 UIGenerator private buildUIfromMethodList {fr methods addrspec} {
150 set mList [lindex $methods 0] ;# un-listify
151 set nameElems ""
152 for {set i 0} {$i < [llength $mList]} {incr i} {
153 if {[string first NAME [lindex $mList $i]] != -1} {
154 lappend nameElems $i
155 }
156 }
157 lappend nameElems [llength $mList]
158 for {set i 0} {$i < [expr [llength $nameElems]-1]} {incr i} {
159 set low [lindex $nameElems $i]
160 set high [lindex $nameElems [expr $i+1]]
161 set mp [lrange $mList $low [expr $high - 1]]
162 Trc $class "meths + params = $mp"
163 frame $fr.$i -relief groove
164 button $fr.$i.b -text [lindex [lindex $mp 0] 1]
165 pack $fr.$i $fr.$i.b
166 set params [lrange $mp 1 end]
167 for {set p 0} {$p < [llength $params]} {incr p} {
168 frame $fr.$i.$p
169 label $fr.$i.$p.l -text [lindex [lindex $params $p] 0]
170 pack $fr.$i.$p $fr.$i.$p.l
171 Trc $class "params = $params"
172 if {[lindex [lindex $params 0] 1] != "LEXTYPE"} {puts "Error!"}
173 set fullLex [lindex [lindex $params $p] 2]
174 set lex [lindex [split $fullLex :] 0]
175 set range [lindex [split $fullLex :] 1]
176 set paramObj$p [$self CreateUIWidgetFromLexType $fr.$i.$p $fullLex]
177 }
178 set comm "$self SendUDP $addrspec [$fr.$i.b cget -text] "
179 for {set j 0} {$j < $p} {incr j} {
180 append comm "\[[set paramObj$j] get_val\] "
181 }
182 Trc $class "COMM = $comm"
183 $fr.$i.b configure -command "$comm"
184 }
185 }
186
187 # actually pass on the method invocation ... args were correctly set up
188 # via XML parse
189 #
190 UIGenerator private SendUDP {args} {
191 Trc $class "${class}::$proc $args"
192 puts "Sending UDP msg: $args"
193 set udp [new UDPChannel [lindex $args 0]]
194 $udp send "[lrange $args 1 end]"
195 delete $udp
196 }
197
198 #
199 # given a window/frame (w) and lexType string, instantiate some UI
200 # widgets in w, return an object that accepts a "get_val" method call
201 # to get the appropriate data.
202 UIGenerator private CreateUIWidgetFromLexType {w fullLexType} {
203 Trc $class "LEXTYPE = $fullLexType"
204 set lexType [lindex [split $fullLexType :] 0]
205 set lexRange [lindex [split $fullLexType :] 1]
206 switch $lexType {
207 remoteCall -
208 boolean {
209 set obj [new CheckButton $w.widget]
210 }
211 int {
212 if {$lexRange == ""} {
213 set obj [new EntryObj $w.widget]
214 } else {
215 set lexRange [lindex [split $lexRange =] 1]
216 set low [lindex [split $lexRange -] 0]
217 set high [lindex [split $lexRange -] 1]
218 set obj [new ScaleObj $w.widget -from $low -to $high \
219 -orient horizontal]
220 }
221 }
222 real {
223 if {$lexRange == ""} {
224 set obj [new EntryObj $w.widget]
225 } else {
226 set lexRange [lindex [split $lexRange =] 1]
227 set low [lindex [split $lexRange -] 0]
228 set high [lindex [split $lexRange -] 1]
229 set obj [new ScaleObj $w.widget -from $low -to $high \
230 -digits 3 -resolution 0.01 -orient horizontal]
231 }
232 }
233 string {
234 set obj [new EntryObj $w.widget]
235 }
236 enum {
237 set obj [new RadioButtonsObj $w [split $lexRange ,]]
238 set noPack 1
239 }
240 }
241 # FIXME stupid special case -- RadioButtons
242 if [info exists noPack] {
243 unset noPack
244 } else {
245 pack $w.widget -side left
246 }
247
248 return $obj
249 }
250
251
252 # fill txt_ array with "flattened" version suitable for iterative
253 # parsing into UI commands (XML must be for objectDescription DTD)
254 #
255 UIGenerator private FlattenXML {parsedXMLlist {w {}}} {
256 $self instvar txt_ lastelem lastw
257 set count 0
258 set xml $parsedXMLlist
259 if ![info exists lastelem] {
260 set lastelem NULL
261 }
262 foreach {type arg1 arg2 arg3} $xml {
263 switch $type {
264 parse:pi -
265 parse:comment -
266 parse:text {
267 lappend txt_($lastw,$lastelem) $arg1
268 }
269 parse:elem {
270 set lastelem $arg1
271 set lastw $w
272 if {$arg1 == "METHOD"} {
273 lappend txt_($w,METHODS) $arg2
274 foreach {t a1 a2 a3} $arg3 {
275 lappend txt_($w,METHODS) "$a1 $a2"
276 }
277 }
278 if {$arg1 == "UI"} {
279 if {$arg2 != ""} {lappend txt_($w,UI) $arg2}
280 }
281 incr count
282 $self FlattenXML $arg3 $w.$count
283 #incr count -1
284
285 }
286 }
287 }
288 }
289
290 #
291 UIGenerator private parseResults {} {
292 $self instvar parseResults_
293 return $parseResults_
294 }
295
296 #
297 UIGenerator private print {} {
298 $self instvar txt_
299 parray txt_
300 }
301
302
303
304
305
306
307 proc parray {a {pattern *}} {
308 upvar 1 $a array
309 if ![array exists array] {
310 error "\"$a\" isn't an array"
311 }
312 set maxl 0
313 foreach name [lsort [array names array $pattern]] {
314 if {[string length $name] > $maxl} {
315 set maxl [string length $name]
316 }
317 }
318 set maxl [expr {$maxl + [string length $a] + 2}]
319 foreach name [lsort [array names array $pattern]] {
320 set nameString [format %s(%s) $a $name]
321 puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
322 }
323 }
324
325
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.