1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
# $Id: register.tcl,v 1.25 2006/05/11 22:07:25 aleksey Exp $
namespace eval register {
set winid 0
}
proc register::open {jid args} {
variable winid
foreach {key val} $args {
switch -- $key {
-connection { set connid $val }
}
}
if {![info exists connid]} {
return -code error "register::open: -connection required"
}
set sw .register$winid
toplevel $sw
wm group $sw .
set title [format [::msgcat::mc "Register in %s"] $jid]
wm title $sw $title
wm iconname $sw $title
wm transient $sw .
if {$::tcl_platform(platform) == "macintosh"} {
catch { unsupported1 style $sw floating sideTitlebar }
} elseif {$::aquaP} {
::tk::unsupported::MacWindowStyle style $sw dBoxProc
}
wm resizable $sw 0 0
ButtonBox $sw.bbox -spacing 0 -padx 10 -default 0
$sw.bbox add -text [::msgcat::mc "Register"] \
-command [list register::register $sw $connid $jid] \
-state disabled
$sw.bbox add -text [::msgcat::mc "Unregister"] \
-command [list register::unregister $sw $connid $jid] \
-state disabled
$sw.bbox add -text [::msgcat::mc "Cancel"] -command [list destroy $sw]
bind $sw <Return> "ButtonBox::invoke $sw.bbox default"
bind $sw <Escape> "ButtonBox::invoke $sw.bbox 2"
pack $sw.bbox -padx 2m -pady 2m -anchor e -side bottom
Separator::create $sw.sep -orient horizontal
pack $sw.sep -side bottom -fill x -pady 1m
frame $sw.error
pack $sw.error -expand no -fill x -padx 2m -pady 0m
frame $sw.fields
pack $sw.fields -expand yes -fill both -padx 2m -pady 0m
frame $sw.delim
pack $sw.delim -expand no -fill x -padx 2m -pady 1m
bind $sw.fields <Destroy> [list data::cleanup $sw.fields]
wm withdraw $sw
jlib::send_iq get \
[jlib::wrapper:createtag query \
-vars [list xmlns $::NS(register)]] \
-to $jid \
-connection $connid \
-command [list register::recv_fields $sw $connid $jid]
incr winid
}
proc register::recv_fields {sw connid jid res child} {
debugmsg register "$res $child"
switch -- $res {
ERR {
destroy $sw
MessageDlg ${sw}_err -aspect 50000 -icon error \
-message [format [::msgcat::mc "Registration: %s"] \
[error_to_string $child]] \
-type user -buttons ok -default 0 -cancel 0
}
OK {
jlib::wrapper:splitxml $child tag vars isempty chdata children
if {[jlib::wrapper:getattr $vars xmlns] == $::NS(register)} {
data::fill_fields $sw.fields $children
}
$sw.bbox itemconfigure 0 -state normal
if {$jid != [jlib::connection_server $connid]} {
$sw.bbox itemconfigure 1 -state normal
}
wm deiconify $sw
foreach child [winfo children $sw.fields] {
if {[cequal [winfo class $child] Entry] && \
[cequal [$child cget -state] normal]} {
focus $child
break
}
}
}
default {
destroy $sw
}
}
}
proc register::register {sw connid jid} {
variable data
destroy $sw.error.msg
$sw.bbox itemconfigure 0 -state disabled
$sw.bbox itemconfigure 1 -state disabled
set restags [data::get_tags $sw.fields]
jlib::send_iq set [jlib::wrapper:createtag query \
-vars [list xmlns $::NS(register)] \
-subtags $restags] \
-to $jid \
-connection $connid \
-command [list register::recv_result $sw $connid $jid]
}
proc register::unregister {sw connid jid} {
variable data
destroy $sw.error.msg
$sw.bbox itemconfigure 0 -state disabled
$sw.bbox itemconfigure 1 -state disabled
jlib::send_iq set [jlib::wrapper:createtag query \
-vars [list xmlns $::NS(register)] \
-subtags [list [jlib::wrapper:createtag remove]]] \
-to $jid \
-connection $connid \
-command [list register::recv_result $sw $connid $jid]
}
proc register::recv_result {sw connid jid res child} {
global font
variable data
debugmsg register "$res $child"
if {![cequal $res OK]} {
$sw.bbox itemconfigure 0 -state normal
if {$jid != [jlib::connection_server $connid]} {
$sw.bbox itemconfigure 1 -state normal
}
set m [message $sw.error.msg \
-aspect 50000 \
-text [error_to_string $child] \
-font $font \
-pady 2m]
$m configure -foreground [option get $m errorForeground Message]
pack $m
return
}
set result [::msgcat::mc "Registration is successful!"]
label $sw.result -text $result
pack $sw.result -expand yes -fill both -after $sw.fields -anchor nw \
-padx 1c -pady 1c
pack forget $sw.fields
pack forget $sw.bbox
ButtonBox $sw.bbox1 -spacing 0 -padx 10 -default 0
$sw.bbox1 add -text [::msgcat::mc "Close"] -command [list destroy $sw]
bind $sw <Return> "ButtonBox::invoke $sw.bbox1 default"
bind $sw <Escape> "ButtonBox::invoke $sw.bbox1 0"
pack $sw.bbox1 -padx 2m -pady 2m -anchor e -side bottom -before $sw.sep
}
hook::add postload_hook \
[list browser::register_ns_handler $::NS(register) register::open \
-desc [list * [::msgcat::mc "Register"]]]
hook::add postload_hook \
[list disco::browser::register_feature_handler $::NS(register) register::open \
-desc [list * [::msgcat::mc "Register"]]]
|
