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

Revision 734, 4.8 KB (checked in by ucackha, 16 years ago)

Added registry code from RAT + tidying up. Kris

  • 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        global V
38        set owner ""
39        set email ""
40        catch {set owner [registry get "HKEY_CURRENT_USER\\Software\\Mbone Applications\\common" "*rtpName"]}
41        catch {set email [registry get "HKEY_CURRENT_USER\\Software\\Mbone Applications\\common" "*rtpEmail"]}
42        if {$owner!="" && $email!=""} {
43                option add *rtpName "$owner" interactive
44                option add *rtpEmail "$email" interactive
45                return
46        }
47
48        set w .form
49        global V
50        frame $w
51
52        frame $w.msg -relief ridge
53        label $w.msg.label -font [mediumfont] -wraplength 4i \
54                -justify left -text \
55"Please specify values for the following resources. \
56These strings will identify you by name and by email address \
57in any RTP-based conference.  Please use your real name and \
58affiliation instead of a ``handle'', e.g., ``Jane Doe (ACME Research)''. \
59The values you enter will be saved in the Windows registry under the \
60Software\\Vic\\vic key so you will not have to re-enter them." -relief ridge
61
62        pack $w.msg.label -padx 6 -pady 6
63        pack $w.msg -side top
64
65        foreach i {name email} {
66                frame $w.$i -bd 2
67                entry $w.$i.entry -relief sunken
68                label $w.$i.label -width 10 -anchor e
69                pack $w.$i.label -side left
70                pack $w.$i.entry -side left -fill x -expand 1 -padx 8
71        }
72        $w.name.label config -text *rtpName:
73        $w.email.label config -text *rtpEmail:
74        pack $w.msg -pady 10
75        pack $w.name $w.email -side top -fill x
76
77        set owner ""
78        catch {set owner [registry get "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion" "RegisteredOwner"]}
79        if { $owner == "" } {
80            catch {set owner [registry get "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion" "RegisteredOwner"]}
81        }
82
83        set org ""
84        catch {set org [registry get "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion" "RegisteredOrganization"]}
85        if { $org == "" } {
86            catch {set org [registry get "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion" "RegisteredOrganization"]}
87        }
88
89        $w.name.entry insert 0 [format "%s (%s)" $owner $org ]
90        $w.email.entry insert 0 [email_heursitic]
91
92        frame $w.buttons
93        button $w.buttons.accept -text Accept -command "set dialogDone 1"
94        button $w.buttons.dismiss -text Quit -command "set dialogDone -1"
95        pack $w.buttons.accept $w.buttons.dismiss \
96                -side left -expand 1 -padx 20 -pady 10
97        pack $w.buttons
98        pack $w -padx 10
99
100        global dialogDone
101        while { 1 } {
102                set dialogDone 0
103                focus $w.name.entry
104                tkwait variable dialogDone
105                if { $dialogDone < 0 } {
106                        exit 0
107                }
108                set name [string trim [$w.name.entry get]]
109                if { [string length $name] <= 3 } {
110                        open_dialog "please enter a reasonable name"
111                        continue
112                }
113                set email [string trim [$w.email.entry get]]
114                if { [string first . $email] < 0 || \
115                        [string first @ $email] < 0 } {
116                        open_dialog "email address should have form user@host.domain"
117                        continue
118                }
119                break
120        }
121        option add *rtpName "$name" interactive
122        option add *rtpEmail "$email" interactive
123
124        registry set "HKEY_CURRENT_USER\\Software\\Mbone Applications\\common" "*rtpName" "$name"
125        registry set "HKEY_CURRENT_USER\\Software\\Mbone Applications\\common" "*rtpEmail" "$email"
126
127        pack forget $w
128        destroy $w
129}
Note: See TracBrowser for help on using the browser.