1 # application-rtp.tcl --
2 #
3 # The RTPApplication class is the base abstraction for the main program
4 # of an RTP application built from mash components.
5 #
6 # Copyright (c) 1996-2002 The Regents of the University of California.
7 # All rights reserved.
8 #
9 # Redistribution and use in source and binary forms, with or without
10 # modification, are permitted provided that the following conditions are met:
11 #
12 # A. Redistributions of source code must retain the above copyright notice,
13 # this list of conditions and the following disclaimer.
14 # B. Redistributions in binary form must reproduce the above copyright notice,
15 # this list of conditions and the following disclaimer in the documentation
16 # and/or other materials provided with the distribution.
17 # C. Neither the names of the copyright holders nor the names of its
18 # contributors may be used to endorse or promote products derived from this
19 # software without specific prior written permission.
20 #
21 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
22 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
23 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
24 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
25 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
27 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
29 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 #
32 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/common/application-rtp.tcl,v 1.23 2002/08/02 01:02:40 larry Exp $
33
34
35 import Application ErrorWindow mashutils
36
37 #
38 # The RTPApplication class is the base abstraction for the main program
39 # of an RTP application built from mash components. There is one RTPApplication
40 # object per process and it handles the argument parsing, the default
41 # configuration options, and formatting of error messages.
42 #
43 Class RTPApplication -superclass Application
44
45 #
46 # The RTPApplication constructor initializes the RTPApplication object.
47 # The <i>name</i> argument is a string that identifies the
48 # application, i.e., the name of the application.
49 # The first character of <i>name</i> must be lower case
50 # or results are undefined.
51 #
52 RTPApplication public init name {
53 $self next $name
54 }
55
56 #
57 # Bring up a dialog box to prompt the user for his/her configuration and
58 # preferences. "medfont" must be in options database before invoking
59 # this method.
60 #
61 RTPApplication public run_resource_dialog { name email } {
62 # ?Should we move run_resource_dialog here?
63 set font [$self get_option medfont]
64 set w .form
65 global V
66 frame $w
67
68 frame $w.msg -relief ridge
69 label $w.msg.label -font $font -wraplength 4i \
70 -justify left -text \
71 "Please specify values for the following resources. \
72 These strings will identify you by name and by email address \
73 in any RTP-based conference. Please use your real name and \
74 affiliation instead of a ``handle'', e.g., ``Jane Doe (ACME Research)''. \
75 The values you enter will be saved in ~/.mash/prefs so you will \
76 not have to re-enter them." -relief ridge
77
78 pack $w.msg.label -padx 6 -pady 6
79 pack $w.msg -side top
80
81 foreach i {name email} {
82 frame $w.$i -bd 2
83 entry $w.$i.entry -relief sunken
84 label $w.$i.label -width 10 -anchor e
85 pack $w.$i.label -side left
86 pack $w.$i.entry -side left -fill x -expand 1 -padx 8
87 }
88 $w.name.label config -text rtpName:
89 $w.email.label config -text rtpEmail:
90 pack $w.msg -pady 10
91 pack $w.name $w.email -side top -fill x
92
93 $w.$i.entry insert 0 [email_heuristic]
94
95 frame $w.buttons
96 button $w.buttons.accept -text Accept -command "set dialogDone 1"
97 button $w.buttons.dismiss -text Quit -command "set dialogDone -1"
98 pack $w.buttons.accept $w.buttons.dismiss \
99 -side left -expand 1 -padx 20 -pady 10
100 pack $w.buttons
101 pack $w -padx 10
102
103 global dialogDone
104 while { 1 } {
105 set dialogDone 0
106 focus $w.name.entry
107 tkwait variable dialogDone
108 if { $dialogDone < 0 } {
109 exit 0
110 }
111 set name [string trim [$w.name.entry get]]
112 if { [string length $name] <= 3 } {
113 new ErrorWindow "please enter a reasonable name"
114 continue
115 }
116 set email [string trim [$w.email.entry get]]
117 if { [string first . $email] < 0 || \
118 [string first @ $email] < 0 } {
119 new ErrorWindow "email address should have form user@host.domain"
120 continue
121 }
122 break
123 }
124 # option add *rtpName "$name" interactive
125 # option add *rtpEmail "$email" interactive
126
127 global env
128 if {![info exists env(HOME)]} {
129 new ErrorWindow {Your HOME environment variable must be set.}
130 exit 1
131 }
132 set mash [file join $env(HOME) .mash]
133 if {![file exists $mash]} {
134 file mkdir $mash
135 }
136 set f [open [file join $mash prefs] a+ 0644]
137 puts $f "rtpName: $name"
138 puts $f "rtpEmail: $email"
139 close $f
140
141 pack forget $w
142 destroy $w
143 }
144
145 #
146 # Check that the mandatory RTP info is available.
147 # If not, bring up a dialog box to prompt the user
148 # for his/her configuration and preferences.
149 # Under windows, this should be done at software install
150 # time to be consistent with other similar apps
151 # (like NetMeeting and Communicator).
152 #
153 RTPApplication public check_rtp_sdes {} {
154 #
155 # make sure we have mandatory resources
156 #
157 set name [$self get_option rtpName]
158 if { $name == "" } {
159 set name [$self get_option sessionName]
160 option add *rtpName $name startupFile
161 }
162 set email [$self get_option rtpEmail]
163 if { $name == "" || $email == "" } {
164 $self run_resource_dialog $name $email
165 }
166 }
167
168 #
169 # Check that the address specification <i>argv</i> is valid and present
170 # (if needed). Returns its argument.
171 #
172 RTPApplication private check_hostspec { argv megaSession } {
173 if { $argv == "" } {
174 if { $megaSession == "" } {
175 set argv [$self run_session_dialog]
176 return [$self check_hostspec $argv $megaSession]
177 }
178 } elseif { [llength $argv] > 1 } {
179 set extra [lindex $argv 1]
180 $self fatal "extra arguments (starting with $extra)"
181 }
182 return $argv
183 }
184
185 #
186 # No address is specified, display a dialog box to request an IP address
187 # and port number.
188 #
189 RTPApplication public run_session_dialog { } {
190 global V
191 set font [$self get_option medfont]
192 set w .saddrform
193 frame $w
194 frame $w.msg -relief ridge
195 label $w.msg.label -font $font -wraplength 3i \
196 -justify left -text \
197 "Please specify a session address. The address should \
198 be an ``IP address/port number'', e.g., ``227.2.3.4/22334''." -relief ridge
199 pack $w.msg.label -padx 6 -pady 6
200 pack $w.msg -side top
201 frame $w.saddr -bd 2
202 entry $w.saddr.entry -relief sunken
203 bind $w.saddr.entry <Return> {set dialogDone 1}
204 label $w.saddr.label -width 10 -anchor e
205 pack $w.saddr.label -side left
206 pack $w.saddr.entry -side left -fill x -expand 1 -padx 8
207
208 $w.saddr.label config -text "IPAddr/port#:"
209 pack $w.msg -pady 10
210 pack $w.saddr -side top -fill x
211 frame $w.buttons
212 button $w.buttons.accept -text Accept -command "set dialogDone 1"
213 button $w.buttons.dismiss -text Quit -command "set dialogDone -1"
214 pack $w.buttons.accept $w.buttons.dismiss \
215 -side left -expand 1 -padx 20 -pady 10
216 pack $w.buttons
217 pack $w -padx 10
218 global dialogDone
219 while { 1 } {
220 set dialogDone 0
221 focus $w.saddr.entry
222 tkwait variable dialogDone
223 if { $dialogDone < 0 } {
224 exit 0
225 }
226 set saddr [string trim [$w.saddr.entry get]]
227 break
228 }
229 pack forget $w
230 destroy $w
231 return $saddr
232 }
233
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.