1 # ui.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1997-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 ScrolledListbox DropDown UIBook ImageTextButton
33
34
35 proc bind_all { keys script } {
36 foreach key $keys {
37 bind . $key $script
38 }
39 }
40
41
42 Class HandoffClientUI
43
44
45 WidgetClass BSEntry -superclass ListLabelItem -default {
46 { *selectBackground WidgetDefault(-background) }
47 { *selectForeground WidgetDefault(-foreground) }
48 { *selectRelief flat }
49 { *Label*font {Helvetica 10} }
50 { *padY 0 }
51 { .borderWidth 1 }
52 }
53
54
55 BSEntry instproc config_value { option args } {
56 $self instvar value_
57 if { [llength $args]==0 } {
58 return $value_
59 } else {
60 set value_ [lindex $args 0]
61 $self subwidget bs_name configure -text [lindex $value_ 1]
62 $self subwidget bs_lastheard configure \
63 -textvariable [lindex $value_ 2]
64 }
65 }
66
67
68 BSEntry instproc create_root_widget { path } {
69 frame $path -class [$self info class]
70 }
71
72
73 BSEntry instproc build_widget { path } {
74 label $path.bs_name -anchor w -padx 10
75 label $path.bs_lastheard -padx 10 -width 8
76 pack $path.bs_name -side left -fill both -expand 1
77 pack $path.bs_lastheard -side left -fill y
78 }
79
80
81 BSEntry instproc config_select { value } {
82 $self instvar config_
83 if { $value } {
84 $self config_selectbackground $config_(-selectbackground)
85 $self config_selectforeground $config_(-selectforeground)
86 if { !$config_(-highlight) } {
87 $self widget_proc configure \
88 -relief $config_(-selectrelief)
89 }
90 } else {
91 $self config_normalbackground $config_(-normalbackground)
92 $self config_normalforeground $config_(-normalforeground)
93 if { !$config_(-highlight) } {
94 $self widget_proc configure \
95 -relief $config_(-normalrelief)
96 }
97 }
98 }
99
100
101 BSEntry instproc config_normalbackground { value } {
102 if { ![$self set config_(-select)] } {
103 $self subwidget bs_name configure -bg $value
104 $self subwidget bs_lastheard configure -bg $value
105 }
106 }
107
108
109 BSEntry instproc config_normalforeground { value } {
110 if { ![$self set config_(-select)] } {
111 $self subwidget bs_name configure -fg $value
112 $self subwidget bs_lastheard configure -fg $value
113 }
114 }
115
116
117 BSEntry instproc config_selectbackground { value } {
118 if { [$self set config_(-select)] } {
119 $self subwidget bs_name configure -bg $value
120 $self subwidget bs_lastheard configure -bg $value
121 }
122 }
123
124
125 BSEntry instproc config_selectforeground { value } {
126 if { [$self set config_(-select)] } {
127 $self subwidget bs_name configure -fg $value
128 $self subwidget bs_lastheard configure -fg $value
129 }
130 }
131
132
133
134 WidgetClass DropDown/BSList -superclass DropDown -default {
135 { *Menubutton.borderWidth 1 }
136 { *Menubutton.highlightThickness 0 }
137 { *Menubutton.padX 0 }
138 { *Menubutton.padY 0 }
139 { *Menu.font {Helvetica 10} }
140 { *BSEntry.highlightThickness 0 }
141 { *BSEntry.takeFocus 0 }
142 { *BSEntry.borderWidth 2 }
143 { *BSEntry.relief groove }
144 { *BSEntry.selectRelief groove }
145 { *BSEntry.normalRelief groove }
146 { *BSEntry.padY 0 }
147 }
148
149
150 DropDown/BSList instproc build_widget { path } {
151 BSEntry $path.entry
152 pack $path.entry -side left -fill both -expand 1
153
154 $self next $path
155 pack configure $path.button -side right -fill y -expand 0
156 }
157
158
159 DropDown/BSList instproc insert_item { index value } {
160 $self subwidget entry configure -value $value
161 $self subwidget menu insert $index command -label [lindex $value 1] \
162 -command "[list $self] set_var [list $value]"
163 }
164
165
166 DropDown/BSList instproc var_trace { args } {
167 upvar #0 [$self set var_] global_var
168
169 global foo
170 if [info exists foo] {
171 puts "inside var_trace '$args' '$global_var'"
172 }
173 $self subwidget entry configure -value $global_var
174 }
175
176
177 HandoffClientUI instproc init { path } {
178 $self next
179
180 # name to addr mappings for default basestations
181 $self instvar dns_
182 set dns_(wl,ajanta) 208.1.90.227
183 set dns_(wl,brig) 208.1.90.231
184 set dns_(wl,ketch) 208.1.90.234
185 set dns_(wl,carthage) 208.1.90.226
186 set dns_(wl,yacht) 208.1.90.233
187 set dns_(wl,cruiser) 208.1.90.229
188 set dns_(wl,giza) 208.1.90.228
189 set dns_(wl,dreadnaught) 208.1.90.235
190
191 set dns_(eth,ajanta) 208.1.90.35
192 set dns_(eth,brig) 208.1.90.39
193 set dns_(eth,ketch) 208.1.90.42
194 set dns_(eth,carthage) 208.1.90.34
195 set dns_(eth,yacht) 208.1.90.41
196 set dns_(eth,cruiser) 208.1.90.37
197 set dns_(eth,giza) 208.1.90.36
198 set dns_(eth,dreadnaught) 208.1.90.43
199
200 $self create_ui $path
201 }
202
203
204 HandoffClientUI instproc create_ui { path } {
205 $self instvar agent_
206
207 if { [winfo toplevel $path]==$path } {
208 wm title $path "Handoff Controller"
209 }
210
211 bind $path <Destroy> "if \{ \"$path\" == \"%W\" \} \
212 \{$self destroy_win\}"
213 if { $path=="." } { set path "" }
214 $self set path_ $path
215
216 # create the main frame
217
218 frame $path.main
219 DropDown/BSList $path.dropdown -variable [$self tkvarname curr_bs_]
220 button $path.showhide -image Icons(down) -bd 0 -padx 0 -pady 0 \
221 -activebackground [WidgetClass widget_default \
222 -background] -command "$self show"
223 pack $path.dropdown -fill x -expand 1 -pady 1 -padx 1 -side left \
224 -in $path.main
225 pack $path.showhide -fill y -side left -in $path.main
226 pack $path.main -fill x
227
228 # create the other frame
229 frame $path.other
230 $self create_book $path.book
231 frame $path.buttons
232 ImageTextButton $path.exit -image Icons(cross) -text Exit -underline 1\
233 -options { { image.pady 0 } { text.pady 0 } } -bd 1 \
234 -command "$self exit"
235 ImageTextButton $path.ping -image Icons(browse) -text Ping \
236 -underline 0 -bd 1 -command "$self ping" \
237 -options { { image.pady 0 } { text.pady 0 } }
238 label $path.logo -image Icons(cal) -padx 4 -pady 0
239 bind_all "<Key-x> <Key-X> <Meta-x> <Meta-X>" "+$path.exit invoke"
240 bind_all "<Key-q> <Key-Q> <Meta-q> <Meta-Q>" "+$path.exit invoke"
241 bind_all "<Key-p> <Key-P> <Meta-p> <Meta-P>" "+$path.ping invoke"
242 bind_all "<Key-l> <Key-L> <Meta-l> <Meta-L>" \
243 "+$path.book configure -toppage $path.book.log"
244 bind_all "<Key-s> <Key-S> <Meta-s> <Meta-S>" \
245 "+$path.book configure -toppage $path.book.status"
246
247 pack $path.logo -side left -anchor w -fill y -in $path.buttons
248 pack $path.exit $path.ping -padx 5 -side right -anchor e -fill y \
249 -in $path.buttons
250 pack $path.book -fill both -expand 1 -side top -in $path.other
251 pack $path.buttons -fill x -side bottom -in $path.other
252
253 $self instvar bs_list_
254 set bs_list_ [concat [$self get_option basestations] \
255 [$self get_option morebs]]
256 foreach entry $bs_list_ {
257 set bs_name [lindex $entry 0]
258 set bs_descr [lindex $entry 1]
259 if { [string trim $bs_descr]=={} } { set bs_descr $bs_name }
260 set bs_statusvar [$self tkvarname bs_status_($bs_name)]
261 $path.dropdown insert end \
262 [list $bs_name $bs_descr $bs_statusvar]
263 $path.book.status.list insert end "-id $bs_name \
264 [list $bs_name $bs_descr $bs_statusvar]"
265 }
266
267 $self tkvar curr_bs_
268 trace variable curr_bs_ w "$self switch_bs"
269 }
270
271
272 HandoffClientUI instproc create_book { path } {
273 UIBook $path
274
275 # create the status page
276 set status [frame $path.status]
277 $self tkvar dummy
278 set dummy "Last heard"
279 BSEntry $status.label -value "dummy Base-station\
280 [$self tkvarname dummy]" -options \
281 { { bs_name.font {Helvetica 10 bold} } \
282 { bs_lastheard.font {Helvetica 10 bold} } }
283 ScrolledListbox $status.list -browsecmd "$self browse" \
284 -itemclass BSEntry -bd 2 -relief groove \
285 -scrollbar vertical -options \
286 { { bbox.width 175 } { bbox.height 150 } \
287 { vscroll.width 10 } { vscroll.borderwidth 1 } }
288 pack $status.label -fill x -padx 5
289 pack $status.list -fill both
290 $path add $status text "-text Status"
291
292 # create the log page
293 set log [ScrolledText $path.log]
294 $log configure -scrollbar both -options \
295 { { text.width 35 } { text.height 15 } \
296 { text.borderwidth 1 } { text.font {Helvetica 8} } \
297 { text.state disabled } { text.wrap none } \
298 { vscroll.width 10 } { vscroll.borderwidth 1 } \
299 { hscroll.width 10 } { hscroll.borderwidth 1 } }
300 $path add $log text "-text Log"
301 $path configure -toppage $status
302 }
303
304
305 HandoffClientUI instproc destroy_win { } {
306 $self proc log { args } {
307 }
308
309 $self cancel_ping
310 exit
311 }
312
313
314 HandoffClientUI instproc exit { } {
315 $self instvar path_
316 if { [$path_.ping cget -text] != "Ping" } {
317 $self cancel_ping
318 }
319 exit
320 }
321
322
323 HandoffClientUI instproc set_default { addr } {
324 $self instvar path_
325 $self tkvar curr_bs_
326 if { $addr!={} } {
327 set bs_name [$self lookup_host $addr]
328 if { ![catch {set bs [$path_.book.status.list info value \
329 -id $bs_name]}] } {
330 # this succeeded
331 set curr_bs_ $bs
332 return
333 }
334 }
335
336 set curr_bs_ {unknown unknown {}}
337 }
338
339
340 HandoffClientUI instproc ping { } {
341 $self instvar ping_chan_
342 if [info exists ping_chan_] {
343 $self log "Ping already in progress (pid [pid $chan])"
344 return
345 }
346
347 set spec [$self get_option gatewayaddr]
348 set addr [lindex [split $spec "/"] 0]
349 set ping_chan_ [[System instance] start_ping $addr]
350 fileevent $ping_chan_ readable "$self ping_output"
351
352 $self instvar path_
353 if { [[System instance] ping_needs_cancel] } {
354 $path_.ping configure -text "Cancel ping" -underline 7 \
355 -command "$self cancel_ping"
356 } else {
357 $path_.ping configure -state disabled
358 }
359 }
360
361
362 HandoffClientUI instproc cancel_ping { } {
363 $self instvar ping_chan_
364 if [info exists ping_chan_] {
365 [System instance] kill $ping_chan_
366 #catch {close $ping_chan_}
367 unset ping_chan_
368
369 if [winfo exists .] {
370 # just making sure that the root window hasn't yet
371 # been destroyed
372
373 $self ping_done
374 }
375 }
376 }
377
378
379 HandoffClientUI instproc ping_done { } {
380 $self instvar path_
381 if { [[System instance] ping_needs_cancel] } {
382 $path_.ping configure -text "Ping" -underline 0 \
383 -command "$self ping"
384 } else {
385 $path_.ping configure -state normal
386 }
387 }
388
389
390 HandoffClientUI instproc ping_output { } {
391 $self instvar ping_chan_
392 if [info exists ping_chan_] {
393 while { ![eof $ping_chan_] } {
394 set data [read $ping_chan_ 256]
395 if { [string length $data]==0 } break
396 $self log $data -nonewline
397 }
398
399 if [eof $ping_chan_] {
400 catch {close $ping_chan_}
401 unset ping_chan_
402 $self ping_done
403 }
404 }
405 }
406
407
408 HandoffClientUI instproc browse { bs_name } {
409 $self tkvar curr_bs_
410 $self instvar path_
411 set curr_bs_ [$path_.book.status.list info value -id $bs_name]
412 }
413
414
415 HandoffClientUI instproc show { } {
416 $self instvar path_
417 pack $path_.other -fill both -expand 1 -padx 5 -pady 2
418 $path_.showhide configure -image Icons(up) -command "$self hide"
419 }
420
421
422 HandoffClientUI instproc hide { } {
423 $self instvar path_
424 pack forget $path_.other
425 $path_.showhide configure -image Icons(down) -command "$self show"
426 }
427
428
429 HandoffClientUI instproc attach { agent } {
430 $self set agent_ $agent
431 $self background_update
432 }
433
434
435 HandoffClientUI instproc switch_bs { args } {
436 $self tkvar curr_bs_
437 $self instvar agent_
438 set bs_name [split [lindex $curr_bs_ 0] "/"]
439 if { $bs_name!="unknown" } {
440 set eth_name [lindex $bs_name 0]
441 set wl_name [lindex $bs_name 1]
442 if { $wl_name=="" } { set wl_name $eth_name }
443
444 $agent_ send_announcement [$self lookup_addr eth $eth_name] \
445 [$self lookup_addr wl $wl_name]
446 }
447 }
448
449
450 HandoffClientUI instproc background_update { } {
451 $self tkvar bs_status_
452 $self instvar bs_list_ agent_
453 foreach entry $bs_list_ {
454 set bs_name [lindex $entry 0]
455 set lastheard [$agent_ get_lastheard \
456 [$self lookup_addr wl $bs_name]]
457 set delay [expr [clock seconds] - $lastheard]
458
459 if { $delay > 100 } {
460 set bs_status_($bs_name) "none"
461 } elseif { $delay > 10 } {
462 set bs_status_($bs_name) "> $delay s."
463 } else {
464 set bs_status_($bs_name) "$delay s."
465 }
466 }
467
468 after 2000 "$self background_update"
469 }
470
471
472 HandoffClientUI instproc log { msg {nonewline {}} } {
473 if { $nonewline!={} && $nonewline!="-nonewline" } {
474 error "invalid argument $nonewline"
475 }
476
477 $self instvar path_
478 set text $path_.book.log.text
479 $text configure -state normal
480 if { $nonewline=={} } {
481 $text insert end "$msg\n"
482 } else {
483 $text insert end "$msg"
484 }
485
486 $text yview end
487 set totalLines [lindex [split [$text index end] .] 0]
488 set maxLines [$self get_option maxlogsize]
489 if { $totalLines > $maxLines } {
490 $text delete 1.0 [expr $totalLines - $maxLines].0
491 }
492
493 $text configure -state disabled
494 }
495
496
497 HandoffClientUI instproc lookup_addr { interface name } {
498 # lookup the addresses for the set of default machines
499 # actually returns -wl addrs!
500 $self instvar dns_
501 if [info exists dns_($interface,$name)] {
502 return $dns_($interface,$name)
503 } else {
504 return $name
505 }
506 }
507
508
509 HandoffClientUI instproc lookup_host { addr } {
510 $self instvar dns_
511
512 # search the array for this IP address
513 set id [array startsearch dns_]
514 while { [array anymore dns_ $id] } {
515 set elem [array nextelement dns_ $id]
516 if { $dns_($elem)==$addr } {
517 # found the entry
518 set name [lindex [split $elem ","] 1]
519 if { $name!="" } {
520 array donesearch dns_ $id
521 return $name
522 }
523 }
524 }
525
526 return $addr
527 }
528
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.