1 # ui-srvalloc.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1996-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 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/applications/uc/ui-srvalloc.tcl,v 1.7 2002/02/03 04:22:33 lim Exp $
32
33
34 import Trace CheckButton Observer RendezvousManager
35 #Trace on ; Trace add SrvAllocUI
36
37 # class that observes msgs on the rendezvous channel indicating
38 # new services are available that can be allocated, and presents
39 # a dynamic list of them to the user allowing him or her to choose
40 # which ones to actually request.
41 #
42 Class SrvAllocUI -superclass Observer
43
44
45 #
46 # FIXME need to ask rv_ for all previous "can-allocate" msgs to avoid
47 # startup delay
48 #
49 SrvAllocUI public init {w spec} {
50 Trc $class "--> ${class}::$proc"
51 $self next
52
53 $self init_network $spec
54 $self init_gui $w
55 $self update_gui
56 }
57
58 #
59 SrvAllocUI public destroy {} {
60 Trc $class "--> ${class}::$proc"
61 $self instvar rv_ req_msgs_
62 # stop any rv msgs
63 foreach r [array names req_msgs_] {
64 foreach m $req_msgs_($r) {
65 catch {$rv_ stop $r $m}
66 }
67 }
68 $rv_ detach_observer $self
69 $self next
70 }
71
72
73 #
74 SrvAllocUI private init_network {spec} {
75 Trc $class "--> ${class}::$proc"
76 $self instvar rv_
77
78 foreach rv [RendezvousManager info instances] {
79 if {[lsearch -exact [$rv get_specs] $spec] != -1} {
80 set rv_ $rv
81 }
82 }
83 if ![info exists rv_] {
84 set rv_ [new RendezvousManager $spec]
85 }
86 $rv_ attach_observer $self
87 }
88
89 #
90 SrvAllocUI private parse_components {rvmsg} {
91 Trc $class "--> ${class}::$proc [$rvmsg data]"
92 $self instvar components_
93 set uid [$rvmsg get_field uniqid]
94 set rspec [$rvmsg rspec]
95
96 # only add components once
97 if {[array names components_ $rspec] == "" || \
98 [lsearch -exact $components_($rspec) $uid] == -1} {
99 lappend components_($rspec) $uid
100 }
101 #parray components_
102 }
103
104
105 #
106 SrvAllocUI private init_gui {w} {
107 Trc $class "--> ${class}::$proc"
108 $self instvar components_ w_
109 set w_ $w
110
111 # bottom informational label
112 set il $w.infolabel
113 frame $il -relief groove
114 label $il.l -text "Service Allocator"
115 pack $il -side bottom -fill x -expand 1
116 pack $il.l -in $il -side bottom
117
118 # srvs frame
119 frame $w.listFrame -relief groove
120 pack $w.listFrame -side left -fill y -expand 1
121 }
122
123 #
124 SrvAllocUI private update_gui {} {
125 Trc $class "--> ${class}::$proc"
126 $self instvar w_ components_ cb_ rv_
127 set w $w_
128 set need_repack 0
129
130 set rspecCnt 0
131 foreach rspec [array names components_] {
132 # create/edit the label associated -w- each rspec
133 set l $w.listFrame.l$rspecCnt
134 if {[info commands $l] == ""} {
135 label $l -text "Scope: [$rv_ get_spec_name $rspec]"
136 } else {
137 $l configure -text "Scope: [$rv_ get_spec_name $rspec]"
138 }
139
140 # under each rspec, create/edit checkbutton per srv
141 set count 0
142 foreach uid $components_($rspec) {
143 set cbpath $w.listFrame.cb${rspecCnt}-$count
144
145 set msg [$rv_ query "can-allocate: & uniqid=$uid"]
146 set ob [$msg get_field mash-object]
147 if {$ob == ""} {
148 set ob [$msg get_field WPI]
149 set ob "WPI:[lindex [split $ob /] end]"
150 }
151 set sname "$ob:"
152 append sname [$msg get_field name]
153
154 if {[info commands $cbpath] == ""} {
155 set need_repack 1
156 set cb_($cbpath) [new CheckButton $cbpath -padx 12 \
157 -text "$sname" \
158 -command "$self checkButtonInvoke $rspec $uid $cbpath"]
159 } else {
160 $cbpath configure -text "$sname" \
161 -command "$self checkButtonInvoke $rspec $uid $cbpath"
162 }
163 incr count
164 }
165 incr rspecCnt
166 }
167
168 # if we added any widgets, repack
169 if $need_repack {
170 foreach i [info commands $w.listFrame.*] {
171 pack forget $i
172 }
173 set rspecCnt 0
174 foreach rspec "[array names components_]" {
175 pack $w.listFrame.l$rspecCnt -side top -anchor w
176 set count 0
177 foreach sname $components_($rspec) {
178 pack $w.listFrame.cb${rspecCnt}-$count -anchor w
179 incr count
180 }
181 incr rspecCnt
182 }
183 }
184 }
185
186 #
187 SrvAllocUI private checkButtonInvoke {rspec uid cbpath} {
188 Trc $class "--> ${class}::$proc"
189 $self instvar cb_
190
191 set cb $cb_($cbpath)
192 if [$cb get_val] {
193 $self start_requesting $rspec $uid
194 } else {
195 $self stop_requesting $rspec $uid
196 }
197 }
198
199
200 # -------------------------------------------------------------
201 # Methods for dealing with a RendezvousManager and its upcalls
202 # --------------------------------------------------------------
203
204
205 #
206 SrvAllocUI private start_requesting {rspec uid} {
207 Trc $class "--> ${class}::$proc"
208 $self instvar rv_ req_msgs_
209 set m "allocate: uniqid=$uid"
210 $rv_ start $rspec $m
211 lappend req_msgs_($rspec) $m
212 }
213
214 #
215 SrvAllocUI private stop_requesting {rspec uid} {
216 Trc $class "--> ${class}::$proc"
217 $self instvar rv_
218 $rv_ stop $rspec "allocate: uniqid=$uid"
219 }
220
221
222 # our main cause of action -- a servent has been found
223 # that can be allocated by the user.
224 SrvAllocUI public rendez_recv_can-allocate {rvmsg} {
225 Trc $class "--> ${class}::$proc"
226 $self parse_components $rvmsg
227 $self update_gui
228 }
229
230 # this upcall is useful only to update labels in the GUI
231 SrvAllocUI public rendez_recv_scope {rvmsg} {
232 $self update_gui
233 }
234
235
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.