Check-in [1a360640ec]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:fixes in tkchat regarding certificate validation errors
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 1a360640ecd9f37d23c52cd4e9b91747470f5b60
User & Date: chw 2016-11-19 12:09:27
Context
2016-11-19
15:03
add tk upstream changes check-in: 73923862b9 user: chw tags: trunk
12:09
fixes in tkchat regarding certificate validation errors check-in: 1a360640ec user: chw tags: trunk
12:03
add tcl upstream changes check-in: 64a4eb7a64 user: chw tags: trunk
Changes

Changes to tkchat/assets/app/jabberlib/jlibtls.tcl.

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
..
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
#  jlibtls.tcl --
#  
#      This file is part of the jabberlib. It provides support for the
#      tls network socket security layer.
#      
#  Copyright (c) 2004  Mats Bengtsson
#  
# $Id: jlibtls.tcl,v 1.5 2005/02/16 14:26:46 matben Exp $

package require tls

package provide jlibtls 1.0


namespace eval jlib { }

proc jlib::starttls {jlibname cmd args} {
    
    upvar ${jlibname}::locals locals
    
    Debug 2 "jlib::starttls"

    set locals(tls,uargs) $args
    set locals(tls,cmd) $cmd
    
    # Set up callbacks for elements that are of interest to us.
    element_register $jlibname failure [namespace current]::tls_failure
    element_register $jlibname proceed [namespace current]::tls_proceed

    if {[info exists locals(features)]} {
	tls_continue $jlibname
    } else {
	
	# Must be careful so this is not triggered by a reset or something...
	trace add variable ${jlibname}::locals(features) write \
	  [list [namespace current]::tls_features_write $jlibname]
    }
}

proc jlib::tls_features_write {jlibname name1 name2 op} {
    
    Debug 2 "jlib::tls_features_write"
    
    trace remove variable ${jlibname}::locals(features) write \
      [list [namespace current]::tls_features_write $jlibname]
    tls_continue $jlibname
}

proc jlib::tls_continue {jlibname} {
    
    upvar ${jlibname}::locals locals
    variable xmppxmlns

    Debug 2 "jlib::tls_continue"
    
    # Must verify that the server provides a 'starttls' feature.
    if {![info exists locals(features,starttls)]} {
	tls_finish $jlibname starttls-nofeature
    }
    set xmllist [wrapper::createtag starttls -attrlist [list xmlns $xmppxmlns(tls)]]
    send $jlibname $xmllist
    
    # Wait for 'failure' or 'proceed' element.
}

proc jlib::tls_proceed {jlibname tag xmllist} {    

    upvar ${jlibname}::locals locals
    upvar ${jlibname}::opts opts
    upvar ${jlibname}::lib lib
    variable xmppxmlns
    
    Debug 2 "jlib::tls_proceed"
    
    if {[wrapper::getattribute $xmllist xmlns] != $xmppxmlns(tls)} {
	tls_finish $jlibname starttls-protocolerror \
	  "received incorrectly namespaced proceed element"
    }

    set sock $lib(sock)

................................................................................
    array set a [list -cafile "" -certfile "" -keyfile "" \
                     -request 1 -server 0 -require 0 -ssl2 no -ssl3 no -tls1 yes]
    array set a $locals(tls,uargs)
    eval [linsert [array get a] 0 ::tls::import $sock]
    #tls::import $sock -cafile "" -certfile "" -keyfile "" \
    #  -request 1 -server 0 -require 0 -ssl2 no -ssl3 no -tls1 yes
    set retry 0
    
    while {1} {
	if {$retry > 20} {
	    catch {close $sock}
	    set err "too long retry to setup SSL connection"
	    tls_finish $jlibname startls-failure $err
	}
	if {[catch {tls::handshake $sock} err]} {
	    if {[string match "*resource temporarily unavailable*" $err]} {
		after 50  
		incr retry
	    } else {
		catch {close $sock}
		tls_finish $jlibname startls-failure $err


	    }
	} else {
	    break
	}
    }
    
    wrapper::reset $lib(wrap)
    
    # We must clear out any server info we've received so far.
    stream_reset $jlibname
    
    set xml "<stream:stream\
      xmlns='$opts(-streamnamespace)' xmlns:stream='$xmppxmlns(stream)'\
      to='$locals(server)' xml:lang='[getlang]' version='1.0'>"

    # The tls package resets the encoding to: -encoding binary
    fconfigure $sock -encoding utf-8
    eval $lib(transportsend) {$xml}

    # Must be careful so this is not triggered by a reset or something...
    trace add variable ${jlibname}::locals(features) write \
      [list [namespace current]::tls_features_write_2nd $jlibname]
    
    return {}
}

proc jlib::tls_features_write_2nd {jlibname name1 name2 op} {
    
    Debug 2 "jlib::tls_features_write_2nd"
    
    trace remove variable ${jlibname}::locals(features) write \
      [list [namespace current]::tls_features_write_2nd $jlibname]
    
    tls_finish $jlibname
}

proc jlib::tls_failure {jlibname tag xmllist} {

    upvar ${jlibname}::locals locals
    variable xmppxmlns

    Debug 2 "jlib::tls_failure"
    
    if {[wrapper::getattribute $xmllist xmlns] == $xmppxmlns(tls)} {
	tls_finish $jlibname startls-failure "tls failed"
    } else {
	tls_finish $jlibname startls-failure "tls failed for an unknown reason"
    }
    return {}
}

proc jlib::tls_finish {jlibname {errcode ""} {msg ""}} {

    upvar ${jlibname}::locals locals
    
    Debug 2 "jlib::tls_finish errcode=$errcode, msg=$msg"

    element_deregister $jlibname failure [namespace current]::tls_failure
    element_deregister $jlibname proceed [namespace current]::tls_proceed
    
    if {$errcode != ""} {
	uplevel #0 $locals(tls,cmd) $jlibname [list error [list $errcode $msg]]
    } else {
	uplevel #0 $locals(tls,cmd) $jlibname [list result {}]
    }
}

# jlib::tls_reset --
# 
# 

proc jlib::tls_reset {jlibname} {
    
    upvar ${jlibname}::locals locals

    trace remove variable ${jlibname}::locals(features) write \
      [list [namespace current]::tls_features_write $jlibname]
}

#-------------------------------------------------------------------------------

|


|

|










|

|




|







<







|

|






|




|






|



|





|

|







 







|








|



|
>
>





|

|


|





|





|




|

|


|









|











|




|








|
|


|







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
..
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
#  jlibtls.tcl --
#
#      This file is part of the jabberlib. It provides support for the
#      tls network socket security layer.
#
#  Copyright (c) 2004  Mats Bengtsson
#
# $Id: jlibtls.tcl,v 1.5 2005/02/16 14:26:46 matben Exp $

package require tls

package provide jlibtls 1.0


namespace eval jlib { }

proc jlib::starttls {jlibname cmd args} {

    upvar ${jlibname}::locals locals

    Debug 2 "jlib::starttls"

    set locals(tls,uargs) $args
    set locals(tls,cmd) $cmd

    # Set up callbacks for elements that are of interest to us.
    element_register $jlibname failure [namespace current]::tls_failure
    element_register $jlibname proceed [namespace current]::tls_proceed

    if {[info exists locals(features)]} {
	tls_continue $jlibname
    } else {

	# Must be careful so this is not triggered by a reset or something...
	trace add variable ${jlibname}::locals(features) write \
	  [list [namespace current]::tls_features_write $jlibname]
    }
}

proc jlib::tls_features_write {jlibname name1 name2 op} {

    Debug 2 "jlib::tls_features_write"

    trace remove variable ${jlibname}::locals(features) write \
      [list [namespace current]::tls_features_write $jlibname]
    tls_continue $jlibname
}

proc jlib::tls_continue {jlibname} {

    upvar ${jlibname}::locals locals
    variable xmppxmlns

    Debug 2 "jlib::tls_continue"

    # Must verify that the server provides a 'starttls' feature.
    if {![info exists locals(features,starttls)]} {
	tls_finish $jlibname starttls-nofeature
    }
    set xmllist [wrapper::createtag starttls -attrlist [list xmlns $xmppxmlns(tls)]]
    send $jlibname $xmllist

    # Wait for 'failure' or 'proceed' element.
}

proc jlib::tls_proceed {jlibname tag xmllist} {

    upvar ${jlibname}::locals locals
    upvar ${jlibname}::opts opts
    upvar ${jlibname}::lib lib
    variable xmppxmlns

    Debug 2 "jlib::tls_proceed"

    if {[wrapper::getattribute $xmllist xmlns] != $xmppxmlns(tls)} {
	tls_finish $jlibname starttls-protocolerror \
	  "received incorrectly namespaced proceed element"
    }

    set sock $lib(sock)

................................................................................
    array set a [list -cafile "" -certfile "" -keyfile "" \
                     -request 1 -server 0 -require 0 -ssl2 no -ssl3 no -tls1 yes]
    array set a $locals(tls,uargs)
    eval [linsert [array get a] 0 ::tls::import $sock]
    #tls::import $sock -cafile "" -certfile "" -keyfile "" \
    #  -request 1 -server 0 -require 0 -ssl2 no -ssl3 no -tls1 yes
    set retry 0

    while {1} {
	if {$retry > 20} {
	    catch {close $sock}
	    set err "too long retry to setup SSL connection"
	    tls_finish $jlibname startls-failure $err
	}
	if {[catch {tls::handshake $sock} err]} {
	    if {[string match "*resource temporarily unavailable*" $err]} {
		after 50
		incr retry
	    } else {
		catch {close $sock}
		if {[catch {tls_finish $jlibname startls-failure $err}]} {
		    return
		}
	    }
	} else {
	    break
	}
    }

    wrapper::reset $lib(wrap)

    # We must clear out any server info we've received so far.
    stream_reset $jlibname

    set xml "<stream:stream\
      xmlns='$opts(-streamnamespace)' xmlns:stream='$xmppxmlns(stream)'\
      to='$locals(server)' xml:lang='[getlang]' version='1.0'>"

    # The tls package resets the encoding to: -encoding binary
    catch {fconfigure $sock -encoding utf-8}
    eval $lib(transportsend) {$xml}

    # Must be careful so this is not triggered by a reset or something...
    trace add variable ${jlibname}::locals(features) write \
      [list [namespace current]::tls_features_write_2nd $jlibname]

    return {}
}

proc jlib::tls_features_write_2nd {jlibname name1 name2 op} {

    Debug 2 "jlib::tls_features_write_2nd"

    trace remove variable ${jlibname}::locals(features) write \
      [list [namespace current]::tls_features_write_2nd $jlibname]

    tls_finish $jlibname
}

proc jlib::tls_failure {jlibname tag xmllist} {

    upvar ${jlibname}::locals locals
    variable xmppxmlns

    Debug 2 "jlib::tls_failure"

    if {[wrapper::getattribute $xmllist xmlns] == $xmppxmlns(tls)} {
	tls_finish $jlibname startls-failure "tls failed"
    } else {
	tls_finish $jlibname startls-failure "tls failed for an unknown reason"
    }
    return {}
}

proc jlib::tls_finish {jlibname {errcode ""} {msg ""}} {

    upvar ${jlibname}::locals locals

    Debug 2 "jlib::tls_finish errcode=$errcode, msg=$msg"

    element_deregister $jlibname failure [namespace current]::tls_failure
    element_deregister $jlibname proceed [namespace current]::tls_proceed

    if {$errcode != ""} {
	uplevel #0 $locals(tls,cmd) $jlibname [list error [list $errcode $msg]]
    } else {
	uplevel #0 $locals(tls,cmd) $jlibname [list result {}]
    }
}

# jlib::tls_reset --
#
#

proc jlib::tls_reset {jlibname} {

    upvar ${jlibname}::locals locals

    trace remove variable ${jlibname}::locals(features) write \
      [list [namespace current]::tls_features_write $jlibname]
}

#-------------------------------------------------------------------------------

Changes to tkchat/assets/app/tkchat.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
..
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
..
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
...
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
...
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
...
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
...
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
....
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
....
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
....
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
....
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
....
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
....
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
....
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
....
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
....
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
....
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
....
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
....
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
....
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
....
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
....
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
....
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
....
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
....
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
....
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
....
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
....
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
....
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
....
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
....
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
....
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
5892
5893
....
5946
5947
5948
5949
5950
5951
5952
5953
5954
5955
5956
5957
5958
5959
5960
....
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
5994
5995
5996
....
7158
7159
7160
7161
7162
7163
7164
7165
7166
7167
7168
7169
7170
7171
7172
....
7348
7349
7350
7351
7352
7353
7354
7355
7356
7357
7358
7359
7360
7361
7362
....
7658
7659
7660
7661
7662
7663
7664
7665
7666
7667
7668
7669
7670
7671
7672
....
7835
7836
7837
7838
7839
7840
7841

7842

7843
7844
7845
7846
7847
7848
7849
....
7938
7939
7940
7941
7942
7943
7944
7945
7946
7947
7948
7949
7950
7951
7952
....
8027
8028
8029
8030
8031
8032
8033
8034
8035
8036
8037
8038
8039
8040
8041
....
8319
8320
8321
8322
8323
8324
8325
8326
8327
8328
8329
8330
8331
8332
8333
....
8377
8378
8379
8380
8381
8382
8383
8384
8385
8386
8387
8388
8389
8390
8391
....
8579
8580
8581
8582
8583
8584
8585
8586
8587
8588
8589
8590
8591
8592
8593
8594
8595
8596
8597
8598
8599
8600
8601
8602
8603
8604
8605
8606
8607
8608
8609
8610
8611
8612
....
8701
8702
8703
8704
8705
8706
8707
8708
8709
8710
8711
8712
8713
8714
8715
8716
8717
8718
....
9028
9029
9030
9031
9032
9033
9034
9035
9036
9037
9038
9039
9040
9041
9042
....
9150
9151
9152
9153
9154
9155
9156
9157
9158
9159
9160
9161
9162
9163
9164
....
9571
9572
9573
9574
9575
9576
9577
9578
9579
9580
9581
9582
9583
9584
9585
9586
.....
10078
10079
10080
10081
10082
10083
10084
10085
10086
10087
10088
10089
10090
10091
10092
.....
10145
10146
10147
10148
10149
10150
10151
10152
10153
10154
10155
10156
10157
10158
10159
#!/bin/sh
#
# Tk front end to the Tcl'ers chat
#
# -------------------------------------------------------------------------#
# This program is free to use, modify, extend at will, the author(s)
# provides no warantees, guarantees or any responsibility for the use,
# re-use, abuse that may or may not happen. If you somehow sell this
# and make a ton of money - good for you, how about sending me some?
# -------------------------------------------------------------------------
# XMPP Feature Support: 
#   XEP-0012: Last activity
#   XEP-0030: Service discovery
#   XEP-0090: Entity time
#   XEP-0090: Software version
#   XEP-0115: Entity capabilities
#   XEP-0199: XMPP Ping
#   XEP-0232: Software information
................................................................................
      exec wish "$0" ${1+"$@"}

variable Features {
    "http://jabber.org/protocol/disco#info"
    "http://jabber.org/protocol/disco#items"
    "http://jabber.org/protocol/muc"
    "http://jabber.org/protocol/muc#user"
    iq message 
    jabber:iq:version
    jabber:iq:time
    jabber:iq:last
    urn:xmpp:ping
}

if {![info exists env(PATH)]} {
    set env(PATH) .
}

# For development, it is very convenient to be able to drop the extra
# packages into the CVS tree. Make sure we have the real location of 
# the script and not a link.
set script [file normalize [info script]]
while {[file type $script] eq "link"} {
    set script [file join [file dirname $script] [file readlink $script]]
}
set tkchat_dir [file dirname [file normalize $script]]
set imgdir [file join $tkchat_dir images]
................................................................................
catch {package require img::jpeg} ; # more image types (optional)

if {![package vsatisfies [package provide Tk] 8.6]} {
    catch {package require img::png}  ; # more image types (optional)
}
set have_png [expr {[package vsatisfies [package provide Tk] 8.6] \
                        || [package provide img::png] ne {}}]
 
package require sha1		; # tcllib
package require jlib		; # jlib
package require muc		; # jlib
package require disco           ; # jlib 

catch {package require khim}    ; # khim (optional)
catch {package require tooltip 1.2};# tooltips (optional)  

if { ![catch { tk inactive }] } {
    # Idle detection built into tk8.5a3
    namespace eval ::idle {
        proc ::idle::supported {} { return 1 }
        proc ::idle::idletime {} { return [expr { [tk inactive] / 1000 }] }
    }
................................................................................
                    }
                }
            }

            # Add authorisation header to the request (by Anders Ramdahl)
            catch {
                upvar state State
                
                if {[llength [set auth [buildProxyHeaders]]] != 0} {
                    set State(-headers) [concat $auth $State(-headers)]
                }
            }

            set r [list $Options(ProxyHost) $Options(ProxyPort)]
        }
................................................................................
                # Jabber logs
                set I [interp create -safe]
                interp alias $I m {} ::tkjabber::ParseLogMsg
                if { $reverse } {
                    set histTmp $::tkjabber::HistoryLines
                    set ::tkjabber::HistoryLines {}
                }
                # At the moment, the logs are stored in utf-8 format on the 
                # server but get issued as iso-8859-1 due to an error in the 
                # tclhttpd configuration.
                if {[string equal iso8859-1 [set [set tok](charset)]]} {
                    $I eval [encoding convertfrom utf-8 [http::data $tok]]
                } else {
                    $I eval [http::data $tok]
                }
            } err]} then {
................................................................................
	babelfishMenu
    }

    if {$Options(HistoryLines) != 0} {
	set url "$Options(JabberLogs)/?pattern=*.tcl"
	GetHistLogIdx $url
    }
    
    GetTipIndex
    CheckVersion
}

proc ::tkchat::InsertHistoryMark {} {
    # Set a mark for the history insertion point.
    .txt configure -state normal
................................................................................
    # toggles the visibility of the separate (cloned) chat window
    # containing the history
    #
    # Either loads the current contents of the chat window into the
    # separate window and displays it ...
    #
    # ... Or make the window invisible clearing it from all content
    
    variable useTile
    global has_peer
    # remember current position in window:
    set fraction [lindex [.txt yview] 1]
    if {[winfo ismapped .cframe]} {
	# remove cloned window:
	.pane2 forget .cframe
................................................................................
proc ::tkchat::checkNick { w nick clr timestamp } {
    global Options

    # If the nick is > 12 chars truncate it
    if {[string length $nick] > 12} {
        set nick [string range $nick 0 9]...
    }
    
    if { $timestamp == 0 } {
	set timestamp [clock seconds]
    }
    set match 0
    foreach nk $Options(NickList) {
	if { [lindex $nk 0] eq $nick } {
	    if { $timestamp > [lindex $nk 1] } {
................................................................................
	    set Options(Alert,NORMAL) 1
	}
    }
}

proc ::tkchat::addMessage {w clr nick msg msgtype mark timestamp {extraOpts ""}} {
    array set opts $extraOpts
            
    #for colors, it is better to extract the displayed nick from the one used
    #for tags.
    set displayNick $nick
    regexp -- {^<{0,2}(.+?)>{0,2}$} $nick displayNick nick

    set nick [checkNick $w $nick $clr $timestamp]

................................................................................
    if { $mark ne "HISTORY" } {
	set subjectFound [checkAlert $w $msgtype $nick $msg]
	if { $w eq ".txt" } {
            Hook run message $nick $msg $msgtype $mark $timestamp
	}
    } else {
	set subjectFound [checkSubject $w $msgtype $nick $msg]
    }	    

    if { $msgtype eq "ACTION" } {
	$w insert $mark "   * $displayNick " [concat BOOKMARK NICK $tags]
	lappend tags ACTION
    } else {
	$w insert $mark "$displayNick\t" [concat BOOKMARK NICK $tags]
    }
................................................................................
                set Browsers {
                    "Use default browser" xdg-open ""
                    "Mozilla Firefox" firefox "-new-tab"
                    "Google Chrome" google-chrome ""
                    "Opera" opera "-newtab"
                    "Gnome Web Browser" gnome-www-browser "--new-tab"
                }
                
                if {$Options(Browser) eq ""} {
                    foreach {display exe arg} $Browsers {
                        if {[findExecutable $exe cmd]} {
                            if {$arg ne ""} {
                                set Options(Browser) "$cmd $arg"
                            } else {
                                set Options(Browser) $cmd
................................................................................
                  -foreground "#[getColor MainFG]" \
                  -width 80 -height 12 -yscrollcommand [list $bodyf.vs set]]
    ${NS}::scrollbar $bodyf.vs -command [list $bodyf.body yview]
    ${NS}::button $dlg.ok -text [mc OK] -default active \
        -command [namespace code [list SendMemoDone $dlg $jid ok]]
    ${NS}::button $dlg.cancel -text [mc Cancel] \
        -command [namespace code [list SendMemoDone $dlg $jid cancel]]
    
    if {$useTile} {
        $body configure -relief flat -borderwidth 0 -highlightthickness 0
    }

    grid $bodyf.body -row 0 -column 0 -sticky news -padx {1 0} -pady 1
    grid $bodyf.vs   -row 0 -column 1 -sticky news -padx {0 1} -pady 1
    grid rowconfigure $bodyf 0 -weight 1
    grid columnconfigure $bodyf 0 -weight 1
    
    grid $dlg.label $dlg.subject - -sticky ew -padx 1 -pady 1
    grid $bodyf     -            - -sticky news -padx 1 -pady 1
    grid x $dlg.cancel  $dlg.ok    -sticky e -padx 1 -pady 1
    grid rowconfigure $dlg 1 -weight 1
    grid columnconfigure $dlg 1 -weight 1

    bind $body <Key-Tab> { focus [tk_focusNext %W]; break }
................................................................................
	}
	file delete $tmpfile
	addStatus 0 "Installed tkchat desktop menu item"
    } else {
	# This is the Freedesktop specified location.
	set xdg [file join ~ .local share]
	if {[info exists env(XDG_DATA_HOME)]} {
	    set xdg $env(XDG_DATA_HOME) 
	}
	set apps [file join $xdg applications]
	file mkdir $apps
	file copy -force [file join $::tkchat_dir tkchat.desktop] \
	    [file join $apps tkchat.desktop]
	addStatus 0 "Installed tkchat desktop menu item to $apps"
    }
................................................................................
	}
	file delete $tmpfile
	addStatus 0 "Installed tkchat application icon"
    } else {
	# This is the Freedesktop specified location.
	set xdg [file join ~ .local share]
	if {[info exists env(XDG_DATA_HOME)]} {
	    set xdg $env(XDG_DATA_HOME) 
	}
	set apps [file join $xdg icons hicolor 48x48 apps]
	file mkdir $apps
	file copy -force [file join $::tkchat_dir tkchat48.png] \
	    [file join $apps tkchat48.png]
	addStatus 0 "Installed tkchat application icon to $apps"
    }
................................................................................
    variable NS

    SelectTkStyle

    wm title . $chatWindowTitle
    wm withdraw .
    wm protocol . WM_DELETE_WINDOW [namespace origin quit]
    
    if {$have_png} {
        image create photo ::tkchat::img::Tkchat \
            -file [file join $::tkchat_dir tkchat48.png]
    } else {
        image create photo ::tkchat::img::Tkchat \
            -file [file join $::tkchat_dir tkchat48.gif]
    }
................................................................................
                -label [string totitle $theme] \
                -variable Options(Theme) \
                -value $theme \
                -command [list ::tkchat::SetTheme $theme]
	}
	$m add separator
    }
    
    # Local Chat Logging Cascade Menu
    menu $m.chatLog -tearoff 0
    tk::AmpMenuArgs $m add cascade -menu $m.chatLog \
        -label [mc "&Local chat logging"]
    tk::AmpMenuArgs $m.chatLog add radiobutton \
        -label [mc "&Disabled"] \
        -variable Options(ChatLogOff) \
................................................................................
            ::ttk::panedwindow .pane2 -orient vertical
        } else {
            ::ttk::paned .pane2 -orient vertical
        }
    } else {
	panedwindow .pane2 -sashpad 4 -sashrelief ridge -orient vertical
    }
    
    if {$useTile} {
        # We don't have a ttk style for text widgets but we can co-opt
        # the entry border and place our text widget on top of a frame
        # with the entry border plus some padding to make it look right.
        ttk::style theme settings default {
            ttk::style layout FakeText {
                FakeText.field -sticky news -border 0 -children {
................................................................................
    .ml configure -text ">>" -width 0 -command ::tkchat::showExtra

    # Bind the Alt-x key for Entry and Text widgets to toggle
    # the character behind the cursor between a unicode character
    # and its code point (four hex digits).
    # We need two separate handler procs because of the different
    # ways of accessing/setting text in Entry and Text widgets.
    
    bind TEntry <Alt-x> [list ::tkchat::toggleUnicodePoint_e %W]
    bind Entry  <Alt-x> [list ::tkchat::toggleUnicodePoint_e %W]
    bind Text   <Alt-x> [list ::tkchat::toggleUnicodePoint_t %W]

    bind .eMsg <Return>		::tkchat::userPost
    bind .eMsg <KP_Enter>	::tkchat::userPost
    bind .eMsg <Key-Up>		::tkchat::entryUp
................................................................................
        grid configure .txt -in .txtframe -padx {1 0}
        grid configure .sbar -in .txtframe -padx {0 1}
    } else {
        grid .txt .sbar -in .txtframe -sticky news
    }
    grid columnconfigure .txtframe 0 -weight 1
    grid rowconfigure .txtframe 0 -weight 1
    
    .pane2 add .txtframe
    
    # text widget to view history:
    # FIX ME: be nice to have a little theme-specific tab close button here.
    variable useClosebutton
    global has_peer
    ${NS}::frame .cframe -relief groove
    if {$useClosebutton} {
        if {[catch {
................................................................................
    ScrolledWidget $widget_command .clone 0 1 \
	-wrap word -background #f0f0f0 -relief sunken -borderwidth 2 \
	-font FNT -cursor left_ptr -height 1
    .clone tag bind URL <Enter> [list .clone configure -cursor hand2]
    .clone tag bind URL <Leave> [list .clone configure -cursor left_ptr]
    pack .clone -in .cframe -side bottom -expand 1 -fill both
    pack .cbtn -in .cframe -side top -anchor ne -padx 4 -pady 2
    
    .pane add .pane2
    if {$useTile} {
	.pane add $Options(NamesWin)
    } else {
	.pane add $Options(NamesWin) -sticky news
    }
    set lower_row [list .ml .eMsg .post .mb]
................................................................................
    grid configure .eMsg -sticky ew

    grid [CreateStatusbar .status] -sticky ew

    grid rowconfigure	 . 0 -weight 1
    grid columnconfigure . 0 -weight 1
    grid columnconfigure .btm 1 -weight 1
    
    if { $::tcl_platform(os) eq "Windows CE" } {
	wm geometry . 240x300+0+0
    } else {
	if {![winfo exists .splash]} {
	    wm geometry . $Options(Geometry)
	}
    }
................................................................................
            [expr { [winfo width .pane] - [.pane sashpos 0]}]
    } else {
        set Options(PaneUsersWidth) \
            [expr { [winfo width .pane] - [lindex [.pane sash coord 0] 0] }]
    }
    bind .pane <Configure> { after idle [list ::tkchat::PaneConfigure %W %w] }
    bind .pane <Leave>     { ::tkchat::PaneLeave %W }
    
    # update the pane immediately.
    PaneConfigure .pane [winfo width .pane]

    # call this to activate the option on whether the users should be shown
    MsgTo "All Users"
    displayUsers
}
................................................................................
            grid forget .status
        }
    }
}

proc ::tkchat::OnTextFocus {w} {
    global Options
    if {[info exists Options(ClickFocusEntry)] 
        && $Options(ClickFocusEntry)} {
        if {[winfo ismapped .eMsg]} {
            focus .eMsg
        } else {
            focus .tMsg
        }
    } else {
................................................................................
proc ::tkchat::OnEntryPopup {w x y} {
    destroy $w.popup
    set menu [menu $w.popup -tearoff 0]
    if {[$w cget -state] eq "disabled"} {
        $menu add command -label [mc "Unlurk"] -command {::tkchat::LurkMode normal}
    } else {
        $menu add command -label [mc "Lurk"] -command {::tkchat::LurkMode disabled}
    }        
    tk_popup $menu $x $y
}

proc ::tkchat::OnTextPopup { w x y } {
    $w mark set AddBookmark "@$x,$y linestart"

    set m .txt_popup
................................................................................
    lappend txt [list "Open the specified TIP document in web browser"]

    lappend txt "/wiki <text>"
    lappend txt [list "Do a Tclers wiki query with the remainder of the line"]

    lappend txt "/wikipedia <text>"
    lappend txt [list "Send a query to wikipedia (abbr. /wikip <text>)"]
    
    lappend txt "/wiktionary <text>"
    lappend txt [list "Send a query to wikipedia dictionary (abbr. /wikid <text>)"]
    
    lappend txt "/bug ?group? ?tracker? id"
    lappend txt [list "Open a sourceforge tracker item in browser"]

    lappend txt "/noisy ?<nick>? ?<minutes>?"
    lappend txt [list [concat \
	    "Toggle <nick> noisy for x minutes (default 5). Messages from" \
	    "noisy users are not diplayed. Not specifying a nick will give" \
................................................................................
    set txt ""
    lappend txt "/kick nick ?reason?" [list "Remove an undesirable user"]
    lappend txt "/mute nick ?reason?" [list "Globally silence a user"]
    lappend txt "/unmute nick ?reason?" [list "Unmute a muted user"]
    lappend txt "/op nick ?reason?" [list "Make user an administrator"]
    lappend txt "/deop nick ?reason?" [list "Remove admin privileges from user"]
    insertHelpText $w.text $txt
    

    set txt ""
    $w.text insert end "Searching\n" h1

    lappend txt "/?<text>"
    lappend txt [list [concat \
	    "Search the chat buffer for matching text. Repeating the command" \
................................................................................
            -value ssl \
            -command ::tkjabber::TwiddlePort
	${NS}::radiobutton .logon.rstarttls \
            -text [mc "STARTTLS"] \
            -variable Options(UseJabberSSL) \
            -value starttls \
            -command ::tkjabber::TwiddlePort
        
	tk::AmpWidget ${NS}::checkbutton .logon.atc \
            -text [mc "Auto-&connect"] \
            -variable Options(AutoConnect)
        tk::AmpWidget ${NS}::checkbutton .logon.vsc \
            -text [mc "&Validate SSL certificates"] \
        	-variable Options(ValidateSSLChain)
	${NS}::frame  .logon.f  -border 0
................................................................................
    }
    set dlg .irclogon
    variable $dlg {}
    if {![winfo exists $dlg]} {
        set dlg [Dialog $dlg]
        wm withdraw $dlg
        wm title $dlg "Connect to IRC"
        
        set f [${NS}::frame $dlg.f]
        set g [${NS}::frame $f.g]
        ${NS}::label $f.sl -text Server
        ${NS}::entry $f.se -textvariable [namespace which -variable irc](server)
        ${NS}::entry $f.sp -textvariable [namespace which -variable irc](port) -width 5
        ${NS}::label $f.cl -text Channel
        ${NS}::entry $f.cn -textvariable [namespace which -variable irc](channel)
................................................................................
        ${NS}::label $f.nl -text Nick
        ${NS}::entry $f.nn -textvariable [namespace which -variable Options](Nickname)
        ${NS}::button $f.ok -text Login -default active \
            -command [list set [namespace which -variable $dlg] "ok"]
        ${NS}::button $f.cancel -text Cancel \
            -command [list set [namespace which -variable $dlg] "cancel"]
        if {!$useTile} {$f.ok configure -width -8 ; $f.cancel configure -width -8}
        
        bind $dlg <Return> [list $f.ok invoke]
        bind $dlg <Escape> [list $f.cancel invoke]
        wm protocol $dlg WM_DELETE_WINDOW [list $f.cancel invoke]
        
        grid $f.sl $f.se $f.sp -in $g -sticky new -padx 1 -pady 1
        grid $f.cl $f.cn -     -in $g -sticky new -padx 1 -pady 1
        grid $f.nl $f.nn -     -in $g -sticky new -padx 1 -pady 1
        grid columnconfigure $g 1 -weight 1

        grid $g    -         -sticky news
        grid $f.ok $f.cancel -sticky e -padx 1 -pady 1
        grid rowconfigure    $f 0 -weight 1
        grid columnconfigure $f 0 -weight 1
        
        grid $f -sticky news
        grid rowconfigure $dlg 0 -weight 1
        grid columnconfigure $dlg 0 -weight 1

	wm resizable $dlg 0 0
        raise $dlg
    }
................................................................................
proc ::tkchat::registerScreen {} {
    global Options
    variable DlgDone
    variable PasswordCheck ""
    variable NS

    set dlg .register
    
    if {[winfo exists $dlg]} {
        set r .register.f
    } else {
	Dialog $dlg
	wm withdraw $dlg
	wm title $dlg "Register for the Tcler's Chat"
        
        set r [${NS}::frame $dlg.f]
	${NS}::label $r.lfn -text "Full name" -underline 9
	${NS}::label $r.lem -text "Email address" -underline 9
	${NS}::label $r.lnm -text "Chat Username" -underline 9
	${NS}::label $r.lpw -text "Chat Password" -underline 6
	${NS}::label $r.lpwc -text "Confirm Password" -underline 6
	${NS}::entry $r.efn -textvariable Options(Fullname)
................................................................................
	}
    }
    tkchat::SubjectList $w
}
proc ::tkchat::SubjectSel { w idx} {
    global Options
    set m [$w get $idx]
    if {[info exists Options(Subjects)] && 
	[lsearch $Options(Subjects) $m] >= 0} {
	[winfo parent $w].sub delete 0 end
	[winfo parent $w].sub insert end $m
    }
}
proc ::tkchat::SubjectList {w} {
    global Options
................................................................................
    # Here be magic
    variable IMG
    global Images

    if {$location eq ""} {
        set location "http://tkchat.tcl.tk/emoticons/$name.gif"
    }
    
    if {![info exists Images($name,data)] || $Images($name,serial) < $serial} {
        set data [GET $location]
        # silently fail if we can't get the image data
        if {$data eq ""} return
        # the newlines make .tkchatrc look nicer
        set Images($name,data) \n[base64::encode $data]\n
        set Images($name,serial) $serial
................................................................................
    # needed for reload
    array unset IMG
    unset -nocomplain IMGre

    namespace eval ::tkchat::img {
        variable delay 150
    }
    
    # create a slave interpreter with no commands in it.
    set slave [interp create -safe]
    foreach cmd [$slave aliases] {
        $slave alias $cmd {}
    }
    foreach cmd [$slave eval info commands] {
        switch -- $cmd {
................................................................................
            }]
    }
    DoAnim
}

proc ::tkchat::ShowSmiles {} {
    variable NS
    
    set t .smileys
    if {[winfo exists $t]} {
	wm deiconify $t
	raise $t
    } else {
	variable IMG
        set images {}
................................................................................
        tooltip::tooltip $af.cfe "Unset this option to permit setting focus\
            on the main chat widget."
        tooltip::tooltip $af.lpc "Enable logging of private chat conversations\
            to a per-remote-user file in ~/.tkchat_logs."
        tooltip::tooltip $af.abq "Display a confirmation dialog before\
            exiting to permit the user to cancel an accidental quit."
    }
    
    bind $dlg <Alt-s> [list $af.store invoke]
    bind $dlg <Alt-o> [list $af.norminline invoke]
    bind $dlg <Alt-h> [list $af.traffic invoke]
    bind $dlg <Alt-i> [list focus $af.aae]
    grid $af.store   -   -sticky ew -padx 2
    grid $af.norminline - -sticky ew -padx 2
    grid $af.traffic -   -sticky ew -padx 2
................................................................................
        } else {
            set butn [${NS}::button $nb.b_[string map [list "." "X"] $page] \
                          -text $title -command [list raise $page]]
            grid $butn -row 0 -column [incr col] -sticky w
            grid $page -row 1 -column 0 -sticky news -columnspan 100
        }
    }
    
    if {!$use_notebook} {
        grid columnconfigure $nb 0 -weight 1
        grid rowconfigure    $nb 1 -weight 1
        raise [lindex [lindex $pages 0] 1]
    }

    set b_ok [${NS}::button $dlg.ok -text OK -underline 0 -default active \
................................................................................
            [namespace origin on_pres_subscribe]

    }

    set have_tls [expr {[package provide tls] != {}}]
    set socketCmd [info command ::socket]
    if {[llength [package provide Iocpsock]] > 0} {
        set socketCmd ::socket2 
        if {$have_tls} {set ::tls::socketCmd [info command ::socket2]}
    }
    if { [catch {
	if { $Options(UseProxy) && [string length $Options(ProxyHost)] > 0 } {
	    set socket [ProxyConnect $Options(ProxyHost) $Options(ProxyPort) \
		    $Options(JabberServer) $Options(JabberPort)]
	} elseif { $have_tls && $Options(UseJabberSSL) eq "ssl" } {
................................................................................
    global Options
    variable jabber
    variable myId
    variable socket

    CheckCertificate


    fconfigure $socket -encoding utf-8; # this is quite important.


    set user $Options(Username)
    set pass $Options(Password)
    set ress $Options(JabberResource)

    if {[info command ::jlib::havesasl] ne "" && [::jlib::havesasl]} {
	jlib::auth_sasl $jabber $user $ress $pass \
................................................................................
            array set O [split [string trim $cert(subject) /] "/,="]
            array set I [split [string trim $cert(issuer) /] "/,="]
            if {[info exists O(CN)]} {
                tkchat::addStatus SSL $O(CN)
            }
            if {[winfo exists .status.ssl]} {
                .status.ssl configure -image ::tkchat::img::link_secure
                if {[info exists I(O)] 
                    && [llength [package provide tooltip]] > 0} {
                    set tip "Authenticated by $I(O)"
                    if {[package provide tooltip] ne {}} {
                        tooltip::tooltip .status.ssl $tip
                    }
                    bind .status.ssl <Button-1> \
                        [list tkchat::ShowCertificate . 0 [array get cert]]
................................................................................
    global Options
    variable conference
    variable grabNick
    variable ignoreNextNick
    variable jabber
    variable ::tkchat::OnlineUsers
    array set a [linsert $args 0 -extras {} -x {}]
        
    switch -- $what {
	presence {
            set mucinfo [GetMucInfo $a(-x)]
	    set action ""
	    set newnick ""
	    set nick $a(-resource)
	    # online/away/offline, etc.
................................................................................
	    } else {
		if { [string match -nocase "/me *" $m(-body)] } {
		    set m(-body) [string range $m(-body) 4 end]
		    set msgtype ACTION
		} else {
		    set msgtype NORMAL
                    if {[string match "Realname*" $m(-body)]} {
                        # We are handling IRC whois data - should do some 
                        # caching if we can get the nick (mod the bridge)
                    }
		}
                ::tkchat::addMessage \
                    $w $color $from $m(-body) $msgtype end $timestamp
	    }
	}
................................................................................
		    lappend OnlineUsers(IRC) $nick
		}
		set OnlineUsers(IRC) \
                    [lsort -dictionary -unique $OnlineUsers(IRC)]
		::tkchat::updateOnlineNames
		return
	    }
            
            # If this is a new conversation, create a thread
            if {$m(-thread) eq {}} {set m(-thread) [uuid::uuid generate]}
            set Conversation([jlib::jidmap $m(-from)],thread) $m(-thread)

            set subject ""
            if {[info exists m(-subject)]} { set subject $m(-subject) }
            set body ""
................................................................................
            set node [wrapper::getattribute $child node]
            if {$node eq {} || $node eq "http://tkchat.tcl.tk/caps#[get_caps_ver]"} {
                lappend parts [wrapper::createtag identity \
                                   -attrlist {name tkchat type pc category client}]
                foreach feature $Features {
                    lappend parts [wrapper::createtag feature -attrlist [list var $feature]]
                }
                
                set xp [list]
                lappend xp [wrapper::createtag field -attrlist {var FORM_TYPE type hidden} \
                                -subtags [list [wrapper::createtag value \
                                                    -chdata urn:xmpp:dataforms:softwareinfo]]]
                lappend xp [wrapper::createtag field -attrlist {var software} \
                                -subtags [list [wrapper::createtag value -chdata tkchat]]]
                set tkchatver [regexp -inline -- {\d+(?:\.\d+)?} $::tkchat::rcsid]
                lappend xp [wrapper::createtag field -attrlist {var software_version} \
                                -subtags [list [wrapper::createtag value -chdata $tkchatver]]]
                lappend xp [wrapper::createtag field -attrlist {var os} \
                                -subtags [list [wrapper::createtag value -chdata $tcl_platform(os)]]]
                lappend xp [wrapper::createtag field -attrlist {var os_version} \
                                -subtags [list [wrapper::createtag value -chdata $tcl_platform(osVersion)]]]
                
                lappend parts [wrapper::createtag x \
                                   -attrlist {xmlns jabber:x:data type result} -subtags $xp]

            } else {
                
                # no items

            }

            set rsp [wrapper::createtag query -attrlist [list xmlns $xmlns] -subtags $parts]
            $jabber send_iq result [list $rsp] -to $from -id $a(-id)

................................................................................
	}
	result {
	    ::tkchat::addStatus 0 "Logged in."
	    if {$myId == {}} { set myId [$jabber myjid] }
	    variable reconnect 1
	    variable connectionRetryTime [expr {int(5+rand()*5.0)}]
            $jabber send_presence -extras [list [get_caps]]
            
            # request roster from server
            $jabber roster_get {}
                                               
	    set muc [jlib::muc::new $jabber]
	    if { $::Options(Nickname) eq "" } {
		::tkchat::setNickname $::Options(Username)
	    }
	    set baseNick $::Options(Nickname)
	    set nickTries 0
            if {[string length $conference] > 0} {
................................................................................
        time     "jabber:iq:time"
        discover "http://jabber.org/protocol/disco#info"
    }
    if {![info exists q($what)]} {
        return -code error "invalid query \"$what\": must be one of\
            [join [array names q] {, }]"
    }
        
    set jid [get_participant_jid $user]
    set xmllist [wrapper::createtag query -attrlist [list xmlns $q($what)]]
    $tkjabber::jabber send_iq get [list $xmllist] -to $jid
    return
}

proc ::tkjabber::ping {jid} {
................................................................................
	incr total $userCnt
	.pane.names insert end "$userCnt $network Users\n" [list SUBTITLE $network]
        if {$network eq "Jabber"} {
            .pane.names insert end "  Moderators\n" SUBTITLE
            .pane.names insert end "  Participants\n" SUBTITLE
            .pane.names mark set admins [.pane.names index "end - 2 lines"]
        }
        
	.pane.names tag bind $network <Button-1> \
		[list ::tkchat::OnNetworkToggleShow $network]
	if { $OnlineUsers($network,hideMenu) } {
	    continue
	}
	foreach nick $OnlineUsers($network) {
	    set status [lindex $OnlineUsers($network-$nick,status) 0]
................................................................................
proc ::tkjabber::TwiddlePort {} {
    global Options
    if {$Options(UseJabberSSL) eq "ssl" \
            && ($Options(JabberPort) == 5222 \
                    || $Options(JabberPort) == 5223 \
                    || $Options(JabberPort) == 443)} {
        set Options(JabberPort) [expr {$Options(UseProxy) ? 443 : 5223}]
    } elseif {$Options(UseJabberSSL) ne "ssl" 
              && ($Options(JabberPort) == 5223 
                  || $Options(JabberPort) == 443)} {
        set Options(JabberPort) 5222
    }
}

proc ::tkjabber::scheduleReconnect {} {
    variable reconnectTimer
................................................................................
    set wid paste[incr paste_uid]
    set dlg [Dialog .$wid]
    wm title $dlg [mc "Paste data to %s" paste.tclers.tk]
    wm transient $dlg {}
    set f [${NS}::frame $dlg.f1 -borderwidth 0]
    set f2 [${NS}::frame $f.f2 -borderwidth 0]
    ${NS}::label $f2.lbl -text [mc Subject]
    set subject [${NS}::entry $f2.subject -font FNT] 
    text $f.txt -background white -font FNT -yscrollcommand [list $f.vs set]
    ${NS}::scrollbar $f.vs -command [list $f.txt yview]
    set f3 [${NS}::frame $f.f3 -borderwidth 0]
    set send [${NS}::button $f3.send -text [mc "Send"] \
                  -default active -width -12 \
                  -command [list set [namespace current]::$wid send]]
    set cancel [${NS}::button $f3.cancel -text [mc "Cancel"] \
................................................................................
        }
    }
    destroy $dlg
    unset [namespace current]::$wid
    return
}

# Store personal incoming messages in mbox format (as per the qmail mbox 
# man page.
proc ::tkjabber::StoreMessage {from subject message} {
    global env Options
    if {$Options(StoreMessages)} {
        if { [info exists env(HOME)] } {
            set filename [file join $env(HOME) .tkchat_msgs]
            catch {




|





|







 







|











|







 







|



|


|







 







|







 







|
|







 







|







 







|







 







|







 







|







 







|







 







|







 







|








|







 







|







 







|







 







|







 







|







 







|







 







|







 







|

|







 







|







 







|







 







|







 







|







 







|







 







|


|







 







|







 







|







 







|







 







|



|









|







 







|






|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







>
|
>







 







|







 







|







 







|







 







|







 







|













|




|







 







|


|







 







|







 







|







 







|
|







 







|







 







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
..
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
..
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
...
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
...
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
...
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
...
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
....
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
....
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
....
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
....
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
....
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
....
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
....
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
....
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
....
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
....
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
....
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
....
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
....
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
....
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
....
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
....
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
....
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
....
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
....
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
....
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
....
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
....
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
....
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
....
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
....
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
5892
5893
....
5946
5947
5948
5949
5950
5951
5952
5953
5954
5955
5956
5957
5958
5959
5960
....
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
5994
5995
5996
....
7158
7159
7160
7161
7162
7163
7164
7165
7166
7167
7168
7169
7170
7171
7172
....
7348
7349
7350
7351
7352
7353
7354
7355
7356
7357
7358
7359
7360
7361
7362
....
7658
7659
7660
7661
7662
7663
7664
7665
7666
7667
7668
7669
7670
7671
7672
....
7835
7836
7837
7838
7839
7840
7841
7842
7843
7844
7845
7846
7847
7848
7849
7850
7851
....
7940
7941
7942
7943
7944
7945
7946
7947
7948
7949
7950
7951
7952
7953
7954
....
8029
8030
8031
8032
8033
8034
8035
8036
8037
8038
8039
8040
8041
8042
8043
....
8321
8322
8323
8324
8325
8326
8327
8328
8329
8330
8331
8332
8333
8334
8335
....
8379
8380
8381
8382
8383
8384
8385
8386
8387
8388
8389
8390
8391
8392
8393
....
8581
8582
8583
8584
8585
8586
8587
8588
8589
8590
8591
8592
8593
8594
8595
8596
8597
8598
8599
8600
8601
8602
8603
8604
8605
8606
8607
8608
8609
8610
8611
8612
8613
8614
....
8703
8704
8705
8706
8707
8708
8709
8710
8711
8712
8713
8714
8715
8716
8717
8718
8719
8720
....
9030
9031
9032
9033
9034
9035
9036
9037
9038
9039
9040
9041
9042
9043
9044
....
9152
9153
9154
9155
9156
9157
9158
9159
9160
9161
9162
9163
9164
9165
9166
....
9573
9574
9575
9576
9577
9578
9579
9580
9581
9582
9583
9584
9585
9586
9587
9588
.....
10080
10081
10082
10083
10084
10085
10086
10087
10088
10089
10090
10091
10092
10093
10094
.....
10147
10148
10149
10150
10151
10152
10153
10154
10155
10156
10157
10158
10159
10160
10161
#!/bin/sh
#
# Tk front end to the Tcl'ers chat
#
# -------------------------------------------------------------------------
# This program is free to use, modify, extend at will, the author(s)
# provides no warantees, guarantees or any responsibility for the use,
# re-use, abuse that may or may not happen. If you somehow sell this
# and make a ton of money - good for you, how about sending me some?
# -------------------------------------------------------------------------
# XMPP Feature Support:
#   XEP-0012: Last activity
#   XEP-0030: Service discovery
#   XEP-0090: Entity time
#   XEP-0090: Software version
#   XEP-0115: Entity capabilities
#   XEP-0199: XMPP Ping
#   XEP-0232: Software information
................................................................................
      exec wish "$0" ${1+"$@"}

variable Features {
    "http://jabber.org/protocol/disco#info"
    "http://jabber.org/protocol/disco#items"
    "http://jabber.org/protocol/muc"
    "http://jabber.org/protocol/muc#user"
    iq message
    jabber:iq:version
    jabber:iq:time
    jabber:iq:last
    urn:xmpp:ping
}

if {![info exists env(PATH)]} {
    set env(PATH) .
}

# For development, it is very convenient to be able to drop the extra
# packages into the CVS tree. Make sure we have the real location of
# the script and not a link.
set script [file normalize [info script]]
while {[file type $script] eq "link"} {
    set script [file join [file dirname $script] [file readlink $script]]
}
set tkchat_dir [file dirname [file normalize $script]]
set imgdir [file join $tkchat_dir images]
................................................................................
catch {package require img::jpeg} ; # more image types (optional)

if {![package vsatisfies [package provide Tk] 8.6]} {
    catch {package require img::png}  ; # more image types (optional)
}
set have_png [expr {[package vsatisfies [package provide Tk] 8.6] \
                        || [package provide img::png] ne {}}]

package require sha1		; # tcllib
package require jlib		; # jlib
package require muc		; # jlib
package require disco           ; # jlib

catch {package require khim}    ; # khim (optional)
catch {package require tooltip 1.2};# tooltips (optional)

if { ![catch { tk inactive }] } {
    # Idle detection built into tk8.5a3
    namespace eval ::idle {
        proc ::idle::supported {} { return 1 }
        proc ::idle::idletime {} { return [expr { [tk inactive] / 1000 }] }
    }
................................................................................
                    }
                }
            }

            # Add authorisation header to the request (by Anders Ramdahl)
            catch {
                upvar state State

                if {[llength [set auth [buildProxyHeaders]]] != 0} {
                    set State(-headers) [concat $auth $State(-headers)]
                }
            }

            set r [list $Options(ProxyHost) $Options(ProxyPort)]
        }
................................................................................
                # Jabber logs
                set I [interp create -safe]
                interp alias $I m {} ::tkjabber::ParseLogMsg
                if { $reverse } {
                    set histTmp $::tkjabber::HistoryLines
                    set ::tkjabber::HistoryLines {}
                }
                # At the moment, the logs are stored in utf-8 format on the
                # server but get issued as iso-8859-1 due to an error in the
                # tclhttpd configuration.
                if {[string equal iso8859-1 [set [set tok](charset)]]} {
                    $I eval [encoding convertfrom utf-8 [http::data $tok]]
                } else {
                    $I eval [http::data $tok]
                }
            } err]} then {
................................................................................
	babelfishMenu
    }

    if {$Options(HistoryLines) != 0} {
	set url "$Options(JabberLogs)/?pattern=*.tcl"
	GetHistLogIdx $url
    }

    GetTipIndex
    CheckVersion
}

proc ::tkchat::InsertHistoryMark {} {
    # Set a mark for the history insertion point.
    .txt configure -state normal
................................................................................
    # toggles the visibility of the separate (cloned) chat window
    # containing the history
    #
    # Either loads the current contents of the chat window into the
    # separate window and displays it ...
    #
    # ... Or make the window invisible clearing it from all content

    variable useTile
    global has_peer
    # remember current position in window:
    set fraction [lindex [.txt yview] 1]
    if {[winfo ismapped .cframe]} {
	# remove cloned window:
	.pane2 forget .cframe
................................................................................
proc ::tkchat::checkNick { w nick clr timestamp } {
    global Options

    # If the nick is > 12 chars truncate it
    if {[string length $nick] > 12} {
        set nick [string range $nick 0 9]...
    }

    if { $timestamp == 0 } {
	set timestamp [clock seconds]
    }
    set match 0
    foreach nk $Options(NickList) {
	if { [lindex $nk 0] eq $nick } {
	    if { $timestamp > [lindex $nk 1] } {
................................................................................
	    set Options(Alert,NORMAL) 1
	}
    }
}

proc ::tkchat::addMessage {w clr nick msg msgtype mark timestamp {extraOpts ""}} {
    array set opts $extraOpts

    #for colors, it is better to extract the displayed nick from the one used
    #for tags.
    set displayNick $nick
    regexp -- {^<{0,2}(.+?)>{0,2}$} $nick displayNick nick

    set nick [checkNick $w $nick $clr $timestamp]

................................................................................
    if { $mark ne "HISTORY" } {
	set subjectFound [checkAlert $w $msgtype $nick $msg]
	if { $w eq ".txt" } {
            Hook run message $nick $msg $msgtype $mark $timestamp
	}
    } else {
	set subjectFound [checkSubject $w $msgtype $nick $msg]
    }

    if { $msgtype eq "ACTION" } {
	$w insert $mark "   * $displayNick " [concat BOOKMARK NICK $tags]
	lappend tags ACTION
    } else {
	$w insert $mark "$displayNick\t" [concat BOOKMARK NICK $tags]
    }
................................................................................
                set Browsers {
                    "Use default browser" xdg-open ""
                    "Mozilla Firefox" firefox "-new-tab"
                    "Google Chrome" google-chrome ""
                    "Opera" opera "-newtab"
                    "Gnome Web Browser" gnome-www-browser "--new-tab"
                }

                if {$Options(Browser) eq ""} {
                    foreach {display exe arg} $Browsers {
                        if {[findExecutable $exe cmd]} {
                            if {$arg ne ""} {
                                set Options(Browser) "$cmd $arg"
                            } else {
                                set Options(Browser) $cmd
................................................................................
                  -foreground "#[getColor MainFG]" \
                  -width 80 -height 12 -yscrollcommand [list $bodyf.vs set]]
    ${NS}::scrollbar $bodyf.vs -command [list $bodyf.body yview]
    ${NS}::button $dlg.ok -text [mc OK] -default active \
        -command [namespace code [list SendMemoDone $dlg $jid ok]]
    ${NS}::button $dlg.cancel -text [mc Cancel] \
        -command [namespace code [list SendMemoDone $dlg $jid cancel]]

    if {$useTile} {
        $body configure -relief flat -borderwidth 0 -highlightthickness 0
    }

    grid $bodyf.body -row 0 -column 0 -sticky news -padx {1 0} -pady 1
    grid $bodyf.vs   -row 0 -column 1 -sticky news -padx {0 1} -pady 1
    grid rowconfigure $bodyf 0 -weight 1
    grid columnconfigure $bodyf 0 -weight 1

    grid $dlg.label $dlg.subject - -sticky ew -padx 1 -pady 1
    grid $bodyf     -            - -sticky news -padx 1 -pady 1
    grid x $dlg.cancel  $dlg.ok    -sticky e -padx 1 -pady 1
    grid rowconfigure $dlg 1 -weight 1
    grid columnconfigure $dlg 1 -weight 1

    bind $body <Key-Tab> { focus [tk_focusNext %W]; break }
................................................................................
	}
	file delete $tmpfile
	addStatus 0 "Installed tkchat desktop menu item"
    } else {
	# This is the Freedesktop specified location.
	set xdg [file join ~ .local share]
	if {[info exists env(XDG_DATA_HOME)]} {
	    set xdg $env(XDG_DATA_HOME)
	}
	set apps [file join $xdg applications]
	file mkdir $apps
	file copy -force [file join $::tkchat_dir tkchat.desktop] \
	    [file join $apps tkchat.desktop]
	addStatus 0 "Installed tkchat desktop menu item to $apps"
    }
................................................................................
	}
	file delete $tmpfile
	addStatus 0 "Installed tkchat application icon"
    } else {
	# This is the Freedesktop specified location.
	set xdg [file join ~ .local share]
	if {[info exists env(XDG_DATA_HOME)]} {
	    set xdg $env(XDG_DATA_HOME)
	}
	set apps [file join $xdg icons hicolor 48x48 apps]
	file mkdir $apps
	file copy -force [file join $::tkchat_dir tkchat48.png] \
	    [file join $apps tkchat48.png]
	addStatus 0 "Installed tkchat application icon to $apps"
    }
................................................................................
    variable NS

    SelectTkStyle

    wm title . $chatWindowTitle
    wm withdraw .
    wm protocol . WM_DELETE_WINDOW [namespace origin quit]

    if {$have_png} {
        image create photo ::tkchat::img::Tkchat \
            -file [file join $::tkchat_dir tkchat48.png]
    } else {
        image create photo ::tkchat::img::Tkchat \
            -file [file join $::tkchat_dir tkchat48.gif]
    }
................................................................................
                -label [string totitle $theme] \
                -variable Options(Theme) \
                -value $theme \
                -command [list ::tkchat::SetTheme $theme]
	}
	$m add separator
    }

    # Local Chat Logging Cascade Menu
    menu $m.chatLog -tearoff 0
    tk::AmpMenuArgs $m add cascade -menu $m.chatLog \
        -label [mc "&Local chat logging"]
    tk::AmpMenuArgs $m.chatLog add radiobutton \
        -label [mc "&Disabled"] \
        -variable Options(ChatLogOff) \
................................................................................
            ::ttk::panedwindow .pane2 -orient vertical
        } else {
            ::ttk::paned .pane2 -orient vertical
        }
    } else {
	panedwindow .pane2 -sashpad 4 -sashrelief ridge -orient vertical
    }

    if {$useTile} {
        # We don't have a ttk style for text widgets but we can co-opt
        # the entry border and place our text widget on top of a frame
        # with the entry border plus some padding to make it look right.
        ttk::style theme settings default {
            ttk::style layout FakeText {
                FakeText.field -sticky news -border 0 -children {
................................................................................
    .ml configure -text ">>" -width 0 -command ::tkchat::showExtra

    # Bind the Alt-x key for Entry and Text widgets to toggle
    # the character behind the cursor between a unicode character
    # and its code point (four hex digits).
    # We need two separate handler procs because of the different
    # ways of accessing/setting text in Entry and Text widgets.

    bind TEntry <Alt-x> [list ::tkchat::toggleUnicodePoint_e %W]
    bind Entry  <Alt-x> [list ::tkchat::toggleUnicodePoint_e %W]
    bind Text   <Alt-x> [list ::tkchat::toggleUnicodePoint_t %W]

    bind .eMsg <Return>		::tkchat::userPost
    bind .eMsg <KP_Enter>	::tkchat::userPost
    bind .eMsg <Key-Up>		::tkchat::entryUp
................................................................................
        grid configure .txt -in .txtframe -padx {1 0}
        grid configure .sbar -in .txtframe -padx {0 1}
    } else {
        grid .txt .sbar -in .txtframe -sticky news
    }
    grid columnconfigure .txtframe 0 -weight 1
    grid rowconfigure .txtframe 0 -weight 1

    .pane2 add .txtframe

    # text widget to view history:
    # FIX ME: be nice to have a little theme-specific tab close button here.
    variable useClosebutton
    global has_peer
    ${NS}::frame .cframe -relief groove
    if {$useClosebutton} {
        if {[catch {
................................................................................
    ScrolledWidget $widget_command .clone 0 1 \
	-wrap word -background #f0f0f0 -relief sunken -borderwidth 2 \
	-font FNT -cursor left_ptr -height 1
    .clone tag bind URL <Enter> [list .clone configure -cursor hand2]
    .clone tag bind URL <Leave> [list .clone configure -cursor left_ptr]
    pack .clone -in .cframe -side bottom -expand 1 -fill both
    pack .cbtn -in .cframe -side top -anchor ne -padx 4 -pady 2

    .pane add .pane2
    if {$useTile} {
	.pane add $Options(NamesWin)
    } else {
	.pane add $Options(NamesWin) -sticky news
    }
    set lower_row [list .ml .eMsg .post .mb]
................................................................................
    grid configure .eMsg -sticky ew

    grid [CreateStatusbar .status] -sticky ew

    grid rowconfigure	 . 0 -weight 1
    grid columnconfigure . 0 -weight 1
    grid columnconfigure .btm 1 -weight 1

    if { $::tcl_platform(os) eq "Windows CE" } {
	wm geometry . 240x300+0+0
    } else {
	if {![winfo exists .splash]} {
	    wm geometry . $Options(Geometry)
	}
    }
................................................................................
            [expr { [winfo width .pane] - [.pane sashpos 0]}]
    } else {
        set Options(PaneUsersWidth) \
            [expr { [winfo width .pane] - [lindex [.pane sash coord 0] 0] }]
    }
    bind .pane <Configure> { after idle [list ::tkchat::PaneConfigure %W %w] }
    bind .pane <Leave>     { ::tkchat::PaneLeave %W }

    # update the pane immediately.
    PaneConfigure .pane [winfo width .pane]

    # call this to activate the option on whether the users should be shown
    MsgTo "All Users"
    displayUsers
}
................................................................................
            grid forget .status
        }
    }
}

proc ::tkchat::OnTextFocus {w} {
    global Options
    if {[info exists Options(ClickFocusEntry)]
        && $Options(ClickFocusEntry)} {
        if {[winfo ismapped .eMsg]} {
            focus .eMsg
        } else {
            focus .tMsg
        }
    } else {
................................................................................
proc ::tkchat::OnEntryPopup {w x y} {
    destroy $w.popup
    set menu [menu $w.popup -tearoff 0]
    if {[$w cget -state] eq "disabled"} {
        $menu add command -label [mc "Unlurk"] -command {::tkchat::LurkMode normal}
    } else {
        $menu add command -label [mc "Lurk"] -command {::tkchat::LurkMode disabled}
    }
    tk_popup $menu $x $y
}

proc ::tkchat::OnTextPopup { w x y } {
    $w mark set AddBookmark "@$x,$y linestart"

    set m .txt_popup
................................................................................
    lappend txt [list "Open the specified TIP document in web browser"]

    lappend txt "/wiki <text>"
    lappend txt [list "Do a Tclers wiki query with the remainder of the line"]

    lappend txt "/wikipedia <text>"
    lappend txt [list "Send a query to wikipedia (abbr. /wikip <text>)"]

    lappend txt "/wiktionary <text>"
    lappend txt [list "Send a query to wikipedia dictionary (abbr. /wikid <text>)"]

    lappend txt "/bug ?group? ?tracker? id"
    lappend txt [list "Open a sourceforge tracker item in browser"]

    lappend txt "/noisy ?<nick>? ?<minutes>?"
    lappend txt [list [concat \
	    "Toggle <nick> noisy for x minutes (default 5). Messages from" \
	    "noisy users are not diplayed. Not specifying a nick will give" \
................................................................................
    set txt ""
    lappend txt "/kick nick ?reason?" [list "Remove an undesirable user"]
    lappend txt "/mute nick ?reason?" [list "Globally silence a user"]
    lappend txt "/unmute nick ?reason?" [list "Unmute a muted user"]
    lappend txt "/op nick ?reason?" [list "Make user an administrator"]
    lappend txt "/deop nick ?reason?" [list "Remove admin privileges from user"]
    insertHelpText $w.text $txt


    set txt ""
    $w.text insert end "Searching\n" h1

    lappend txt "/?<text>"
    lappend txt [list [concat \
	    "Search the chat buffer for matching text. Repeating the command" \
................................................................................
            -value ssl \
            -command ::tkjabber::TwiddlePort
	${NS}::radiobutton .logon.rstarttls \
            -text [mc "STARTTLS"] \
            -variable Options(UseJabberSSL) \
            -value starttls \
            -command ::tkjabber::TwiddlePort

	tk::AmpWidget ${NS}::checkbutton .logon.atc \
            -text [mc "Auto-&connect"] \
            -variable Options(AutoConnect)
        tk::AmpWidget ${NS}::checkbutton .logon.vsc \
            -text [mc "&Validate SSL certificates"] \
        	-variable Options(ValidateSSLChain)
	${NS}::frame  .logon.f  -border 0
................................................................................
    }
    set dlg .irclogon
    variable $dlg {}
    if {![winfo exists $dlg]} {
        set dlg [Dialog $dlg]
        wm withdraw $dlg
        wm title $dlg "Connect to IRC"

        set f [${NS}::frame $dlg.f]
        set g [${NS}::frame $f.g]
        ${NS}::label $f.sl -text Server
        ${NS}::entry $f.se -textvariable [namespace which -variable irc](server)
        ${NS}::entry $f.sp -textvariable [namespace which -variable irc](port) -width 5
        ${NS}::label $f.cl -text Channel
        ${NS}::entry $f.cn -textvariable [namespace which -variable irc](channel)
................................................................................
        ${NS}::label $f.nl -text Nick
        ${NS}::entry $f.nn -textvariable [namespace which -variable Options](Nickname)
        ${NS}::button $f.ok -text Login -default active \
            -command [list set [namespace which -variable $dlg] "ok"]
        ${NS}::button $f.cancel -text Cancel \
            -command [list set [namespace which -variable $dlg] "cancel"]
        if {!$useTile} {$f.ok configure -width -8 ; $f.cancel configure -width -8}

        bind $dlg <Return> [list $f.ok invoke]
        bind $dlg <Escape> [list $f.cancel invoke]
        wm protocol $dlg WM_DELETE_WINDOW [list $f.cancel invoke]

        grid $f.sl $f.se $f.sp -in $g -sticky new -padx 1 -pady 1
        grid $f.cl $f.cn -     -in $g -sticky new -padx 1 -pady 1
        grid $f.nl $f.nn -     -in $g -sticky new -padx 1 -pady 1
        grid columnconfigure $g 1 -weight 1

        grid $g    -         -sticky news
        grid $f.ok $f.cancel -sticky e -padx 1 -pady 1
        grid rowconfigure    $f 0 -weight 1
        grid columnconfigure $f 0 -weight 1

        grid $f -sticky news
        grid rowconfigure $dlg 0 -weight 1
        grid columnconfigure $dlg 0 -weight 1

	wm resizable $dlg 0 0
        raise $dlg
    }
................................................................................
proc ::tkchat::registerScreen {} {
    global Options
    variable DlgDone
    variable PasswordCheck ""
    variable NS

    set dlg .register

    if {[winfo exists $dlg]} {
        set r .register.f
    } else {
	Dialog $dlg
	wm withdraw $dlg
	wm title $dlg "Register for the Tcler's Chat"

        set r [${NS}::frame $dlg.f]
	${NS}::label $r.lfn -text "Full name" -underline 9
	${NS}::label $r.lem -text "Email address" -underline 9
	${NS}::label $r.lnm -text "Chat Username" -underline 9
	${NS}::label $r.lpw -text "Chat Password" -underline 6
	${NS}::label $r.lpwc -text "Confirm Password" -underline 6
	${NS}::entry $r.efn -textvariable Options(Fullname)
................................................................................
	}
    }
    tkchat::SubjectList $w
}
proc ::tkchat::SubjectSel { w idx} {
    global Options
    set m [$w get $idx]
    if {[info exists Options(Subjects)] &&
	[lsearch $Options(Subjects) $m] >= 0} {
	[winfo parent $w].sub delete 0 end
	[winfo parent $w].sub insert end $m
    }
}
proc ::tkchat::SubjectList {w} {
    global Options
................................................................................
    # Here be magic
    variable IMG
    global Images

    if {$location eq ""} {
        set location "http://tkchat.tcl.tk/emoticons/$name.gif"
    }

    if {![info exists Images($name,data)] || $Images($name,serial) < $serial} {
        set data [GET $location]
        # silently fail if we can't get the image data
        if {$data eq ""} return
        # the newlines make .tkchatrc look nicer
        set Images($name,data) \n[base64::encode $data]\n
        set Images($name,serial) $serial
................................................................................
    # needed for reload
    array unset IMG
    unset -nocomplain IMGre

    namespace eval ::tkchat::img {
        variable delay 150
    }

    # create a slave interpreter with no commands in it.
    set slave [interp create -safe]
    foreach cmd [$slave aliases] {
        $slave alias $cmd {}
    }
    foreach cmd [$slave eval info commands] {
        switch -- $cmd {
................................................................................
            }]
    }
    DoAnim
}

proc ::tkchat::ShowSmiles {} {
    variable NS

    set t .smileys
    if {[winfo exists $t]} {
	wm deiconify $t
	raise $t
    } else {
	variable IMG
        set images {}
................................................................................
        tooltip::tooltip $af.cfe "Unset this option to permit setting focus\
            on the main chat widget."
        tooltip::tooltip $af.lpc "Enable logging of private chat conversations\
            to a per-remote-user file in ~/.tkchat_logs."
        tooltip::tooltip $af.abq "Display a confirmation dialog before\
            exiting to permit the user to cancel an accidental quit."
    }

    bind $dlg <Alt-s> [list $af.store invoke]
    bind $dlg <Alt-o> [list $af.norminline invoke]
    bind $dlg <Alt-h> [list $af.traffic invoke]
    bind $dlg <Alt-i> [list focus $af.aae]
    grid $af.store   -   -sticky ew -padx 2
    grid $af.norminline - -sticky ew -padx 2
    grid $af.traffic -   -sticky ew -padx 2
................................................................................
        } else {
            set butn [${NS}::button $nb.b_[string map [list "." "X"] $page] \
                          -text $title -command [list raise $page]]
            grid $butn -row 0 -column [incr col] -sticky w
            grid $page -row 1 -column 0 -sticky news -columnspan 100
        }
    }

    if {!$use_notebook} {
        grid columnconfigure $nb 0 -weight 1
        grid rowconfigure    $nb 1 -weight 1
        raise [lindex [lindex $pages 0] 1]
    }

    set b_ok [${NS}::button $dlg.ok -text OK -underline 0 -default active \
................................................................................
            [namespace origin on_pres_subscribe]

    }

    set have_tls [expr {[package provide tls] != {}}]
    set socketCmd [info command ::socket]
    if {[llength [package provide Iocpsock]] > 0} {
        set socketCmd ::socket2
        if {$have_tls} {set ::tls::socketCmd [info command ::socket2]}
    }
    if { [catch {
	if { $Options(UseProxy) && [string length $Options(ProxyHost)] > 0 } {
	    set socket [ProxyConnect $Options(ProxyHost) $Options(ProxyPort) \
		    $Options(JabberServer) $Options(JabberPort)]
	} elseif { $have_tls && $Options(UseJabberSSL) eq "ssl" } {
................................................................................
    global Options
    variable jabber
    variable myId
    variable socket

    CheckCertificate

    catch {
	fconfigure $socket -encoding utf-8; # this is quite important.
    }

    set user $Options(Username)
    set pass $Options(Password)
    set ress $Options(JabberResource)

    if {[info command ::jlib::havesasl] ne "" && [::jlib::havesasl]} {
	jlib::auth_sasl $jabber $user $ress $pass \
................................................................................
            array set O [split [string trim $cert(subject) /] "/,="]
            array set I [split [string trim $cert(issuer) /] "/,="]
            if {[info exists O(CN)]} {
                tkchat::addStatus SSL $O(CN)
            }
            if {[winfo exists .status.ssl]} {
                .status.ssl configure -image ::tkchat::img::link_secure
                if {[info exists I(O)]
                    && [llength [package provide tooltip]] > 0} {
                    set tip "Authenticated by $I(O)"
                    if {[package provide tooltip] ne {}} {
                        tooltip::tooltip .status.ssl $tip
                    }
                    bind .status.ssl <Button-1> \
                        [list tkchat::ShowCertificate . 0 [array get cert]]
................................................................................
    global Options
    variable conference
    variable grabNick
    variable ignoreNextNick
    variable jabber
    variable ::tkchat::OnlineUsers
    array set a [linsert $args 0 -extras {} -x {}]

    switch -- $what {
	presence {
            set mucinfo [GetMucInfo $a(-x)]
	    set action ""
	    set newnick ""
	    set nick $a(-resource)
	    # online/away/offline, etc.
................................................................................
	    } else {
		if { [string match -nocase "/me *" $m(-body)] } {
		    set m(-body) [string range $m(-body) 4 end]
		    set msgtype ACTION
		} else {
		    set msgtype NORMAL
                    if {[string match "Realname*" $m(-body)]} {
                        # We are handling IRC whois data - should do some
                        # caching if we can get the nick (mod the bridge)
                    }
		}
                ::tkchat::addMessage \
                    $w $color $from $m(-body) $msgtype end $timestamp
	    }
	}
................................................................................
		    lappend OnlineUsers(IRC) $nick
		}
		set OnlineUsers(IRC) \
                    [lsort -dictionary -unique $OnlineUsers(IRC)]
		::tkchat::updateOnlineNames
		return
	    }

            # If this is a new conversation, create a thread
            if {$m(-thread) eq {}} {set m(-thread) [uuid::uuid generate]}
            set Conversation([jlib::jidmap $m(-from)],thread) $m(-thread)

            set subject ""
            if {[info exists m(-subject)]} { set subject $m(-subject) }
            set body ""
................................................................................
            set node [wrapper::getattribute $child node]
            if {$node eq {} || $node eq "http://tkchat.tcl.tk/caps#[get_caps_ver]"} {
                lappend parts [wrapper::createtag identity \
                                   -attrlist {name tkchat type pc category client}]
                foreach feature $Features {
                    lappend parts [wrapper::createtag feature -attrlist [list var $feature]]
                }

                set xp [list]
                lappend xp [wrapper::createtag field -attrlist {var FORM_TYPE type hidden} \
                                -subtags [list [wrapper::createtag value \
                                                    -chdata urn:xmpp:dataforms:softwareinfo]]]
                lappend xp [wrapper::createtag field -attrlist {var software} \
                                -subtags [list [wrapper::createtag value -chdata tkchat]]]
                set tkchatver [regexp -inline -- {\d+(?:\.\d+)?} $::tkchat::rcsid]
                lappend xp [wrapper::createtag field -attrlist {var software_version} \
                                -subtags [list [wrapper::createtag value -chdata $tkchatver]]]
                lappend xp [wrapper::createtag field -attrlist {var os} \
                                -subtags [list [wrapper::createtag value -chdata $tcl_platform(os)]]]
                lappend xp [wrapper::createtag field -attrlist {var os_version} \
                                -subtags [list [wrapper::createtag value -chdata $tcl_platform(osVersion)]]]

                lappend parts [wrapper::createtag x \
                                   -attrlist {xmlns jabber:x:data type result} -subtags $xp]

            } else {

                # no items

            }

            set rsp [wrapper::createtag query -attrlist [list xmlns $xmlns] -subtags $parts]
            $jabber send_iq result [list $rsp] -to $from -id $a(-id)

................................................................................
	}
	result {
	    ::tkchat::addStatus 0 "Logged in."
	    if {$myId == {}} { set myId [$jabber myjid] }
	    variable reconnect 1
	    variable connectionRetryTime [expr {int(5+rand()*5.0)}]
            $jabber send_presence -extras [list [get_caps]]

            # request roster from server
            $jabber roster_get {}

	    set muc [jlib::muc::new $jabber]
	    if { $::Options(Nickname) eq "" } {
		::tkchat::setNickname $::Options(Username)
	    }
	    set baseNick $::Options(Nickname)
	    set nickTries 0
            if {[string length $conference] > 0} {
................................................................................
        time     "jabber:iq:time"
        discover "http://jabber.org/protocol/disco#info"
    }
    if {![info exists q($what)]} {
        return -code error "invalid query \"$what\": must be one of\
            [join [array names q] {, }]"
    }

    set jid [get_participant_jid $user]
    set xmllist [wrapper::createtag query -attrlist [list xmlns $q($what)]]
    $tkjabber::jabber send_iq get [list $xmllist] -to $jid
    return
}

proc ::tkjabber::ping {jid} {
................................................................................
	incr total $userCnt
	.pane.names insert end "$userCnt $network Users\n" [list SUBTITLE $network]
        if {$network eq "Jabber"} {
            .pane.names insert end "  Moderators\n" SUBTITLE
            .pane.names insert end "  Participants\n" SUBTITLE
            .pane.names mark set admins [.pane.names index "end - 2 lines"]
        }

	.pane.names tag bind $network <Button-1> \
		[list ::tkchat::OnNetworkToggleShow $network]
	if { $OnlineUsers($network,hideMenu) } {
	    continue
	}
	foreach nick $OnlineUsers($network) {
	    set status [lindex $OnlineUsers($network-$nick,status) 0]
................................................................................
proc ::tkjabber::TwiddlePort {} {
    global Options
    if {$Options(UseJabberSSL) eq "ssl" \
            && ($Options(JabberPort) == 5222 \
                    || $Options(JabberPort) == 5223 \
                    || $Options(JabberPort) == 443)} {
        set Options(JabberPort) [expr {$Options(UseProxy) ? 443 : 5223}]
    } elseif {$Options(UseJabberSSL) ne "ssl"
              && ($Options(JabberPort) == 5223
                  || $Options(JabberPort) == 443)} {
        set Options(JabberPort) 5222
    }
}

proc ::tkjabber::scheduleReconnect {} {
    variable reconnectTimer
................................................................................
    set wid paste[incr paste_uid]
    set dlg [Dialog .$wid]
    wm title $dlg [mc "Paste data to %s" paste.tclers.tk]
    wm transient $dlg {}
    set f [${NS}::frame $dlg.f1 -borderwidth 0]
    set f2 [${NS}::frame $f.f2 -borderwidth 0]
    ${NS}::label $f2.lbl -text [mc Subject]
    set subject [${NS}::entry $f2.subject -font FNT]
    text $f.txt -background white -font FNT -yscrollcommand [list $f.vs set]
    ${NS}::scrollbar $f.vs -command [list $f.txt yview]
    set f3 [${NS}::frame $f.f3 -borderwidth 0]
    set send [${NS}::button $f3.send -text [mc "Send"] \
                  -default active -width -12 \
                  -command [list set [namespace current]::$wid send]]
    set cancel [${NS}::button $f3.cancel -text [mc "Cancel"] \
................................................................................
        }
    }
    destroy $dlg
    unset [namespace current]::$wid
    return
}

# Store personal incoming messages in mbox format (as per the qmail mbox
# man page.
proc ::tkjabber::StoreMessage {from subject message} {
    global env Options
    if {$Options(StoreMessages)} {
        if { [info exists env(HOME)] } {
            set filename [file join $env(HOME) .tkchat_msgs]
            catch {