root/vic/trunk/ui-win32.tcl @ 702

Revision 702, 4.4 KB (checked in by ucacsva, 16 years ago)

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1#
2# Copyright (c) 1993-1995 Regents of the University of California.
3# All rights reserved.
4#
5# Redistribution and use in source and binary forms, with or without
6# modification, are permitted provided that the following conditions
7# are met:
8# 1. Redistributions of source code must retain the above copyright
9#    notice, this list of conditions and the following disclaimer.
10# 2. Redistributions in binary form must reproduce the above copyright
11#    notice, this list of conditions and the following disclaimer in the
12#    documentation and/or other materials provided with the distribution.
13# 3. All advertising materials mentioning features or use of this software
14#    must display the following acknowledgement:
15#       This product includes software developed by the Computer Systems
16#       Engineering Group at Lawrence Berkeley Laboratory.
17# 4. Neither the name of the University nor of the Laboratory may be used
18#    to endorse or promote products derived from this software without
19#    specific prior written permission.
20#
21# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
22# 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
25# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
27# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
28# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
30# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
31# SUCH DAMAGE.
32#
33# @(#) $Header$ (LBL)
34
35
36proc run_resource_dialog { name email } {
37        set w .form
38        global V
39        frame $w
40
41        frame $w.msg -relief ridge
42        label $w.msg.label -font [mediumfont] -wraplength 4i \
43                -justify left -text \
44"Please specify values for the following resources. \
45These strings will identify you by name and by email address \
46in any RTP-based conference.  Please use your real name and \
47affiliation instead of a ``handle'', e.g., ``Jane Doe (ACME Research)''. \
48The values you enter will be saved in the Windows registry under the \
49Software\\Vic\\vic key so you will not have to re-enter them." -relief ridge
50
51        pack $w.msg.label -padx 6 -pady 6
52        pack $w.msg -side top
53
54        foreach i {name email} {
55                frame $w.$i -bd 2
56                entry $w.$i.entry -relief sunken
57                label $w.$i.label -width 10 -anchor e
58                pack $w.$i.label -side left
59                pack $w.$i.entry -side left -fill x -expand 1 -padx 8
60        }
61        $w.name.label config -text *rtpName:
62        $w.email.label config -text *rtpEmail:
63        pack $w.msg -pady 10
64        pack $w.name $w.email -side top -fill x
65
66        set owner ""
67        catch {set owner [getregistry "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion" "RegisteredOwner"]}
68        if { $owner == "" } {
69            catch {set owner [getregistry "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion" "RegisteredOwner"]}
70        }
71
72        set org ""
73        catch {set org [getregistry "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion" "RegisteredOrganization"]}
74        if { $org == "" } {
75            catch {set org [getregistry "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion" "RegisteredOrganization"]}
76        }
77
78        $w.name.entry insert 0 [format "%s (%s)" $owner $org ]
79        $w.email.entry insert 0 [email_heursitic]
80
81        frame $w.buttons
82        button $w.buttons.accept -text Accept -command "set dialogDone 1"
83        button $w.buttons.dismiss -text Quit -command "set dialogDone -1"
84        pack $w.buttons.accept $w.buttons.dismiss \
85                -side left -expand 1 -padx 20 -pady 10
86        pack $w.buttons
87        pack $w -padx 10
88
89        global dialogDone
90        while { 1 } {
91                set dialogDone 0
92                focus $w.name.entry
93                tkwait variable dialogDone
94                if { $dialogDone < 0 } {
95                        exit 0
96                }
97                set name [string trim [$w.name.entry get]]
98                if { [string length $name] <= 3 } {
99                        open_dialog "please enter a reasonable name"
100                        continue
101                }
102                set email [string trim [$w.email.entry get]]
103                if { [string first . $email] < 0 || \
104                        [string first @ $email] < 0 } {
105                        open_dialog "email address should have form user@host.domain"
106                        continue
107                }
108                break
109        }
110        option add *rtpName "$name" interactive
111        option add *rtpEmail "$email" interactive
112
113        putregistry "HKEY_CURRENT_USER\\Software\\$V(class)\\$V(app)" "*rtpName" "$name"
114        putregistry "HKEY_CURRENT_USER\\Software\\$V(class)\\$V(app)" "*rtpEmail" "$email"
115
116        pack forget $w
117        destroy $w
118}
Note: See TracBrowser for help on using the browser.