File: tkabber.tcl

package info (click to toggle)
tkabber 0.11.0-3
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 5,252 kB
  • ctags: 2,433
  • sloc: tcl: 48,318; xml: 3,350; sh: 1,387; makefile: 66
file content (277 lines) | stat: -rwxr-xr-x 6,414 bytes parent folder | download
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
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
#!/bin/sh
# the next line restarts using the correct interpreter \
exec wish "$0" -name tkabber "$@"

# $Id: tkabber.tcl 1456 2008-06-08 13:33:26Z sergei $

set interface tk
namespace eval ifacetk {}

set aquaP 0
catch {
    switch -- [tk windowingsystem] {
	classic
	    -
	aqua {
	    set aquaP 1
            set tk_highlightthickness 0
            set tk_relief sunken
            set tk_borderwidth 0
	    set tk_modify Cmd
	    set tk_close Cmd-W

            rename ::bind ::bind_orig
            proc ::bind {args} {
                if {[llength $args] < 2} {
		    return [eval ::bind_orig $args]
		}
		if {[string first "<Control-" [set arg1 [lindex $args 1]]] \
		        == 0} {
            	    set arg1 "<Command-[string range $arg1 9 end]"
                }

                eval ::bind_orig [lreplace $args 1 1 $arg1]
	    }
	}
    }
}
if {!$aquaP} {
    set tk_highlightthickness [string equal $::tcl_platform(platform) "unix"]
    set tk_relief raised
    set tk_borderwidth 1
    set tk_modify Ctrl
    set tk_close Ctrl-F4
}

set rootdir [file dirname [info script]]

if {[package provide starkit] != ""} {
    # In case of a starkit, $rootdir now holds a relative path,
    # so we glue it with the main "mount point"
    set rootdir [file join $::starkit::topdir $rootdir]
}

lappend auto_path $rootdir

package require msgcat
if {[info exists ::env(LC_MESSAGES)]} {
    ::msgcat::mclocale $::env(LC_MESSAGES)
}

tk appname tkabber

set debug_lvls {}

proc debugmsg {level msg} {
    global debug_lvls

    if {[lsearch -exact $debug_lvls $level] >= 0} {
	puts "$level: $msg"
    }
}

proc fullpath {args} {
    global rootdir
    return [eval file join [list $rootdir] $args]
}

proc load_source {args} {
    set fullpath [eval fullpath $args]

    debugmsg tkabber "Loading $fullpath"
    uplevel #0 [list source $fullpath]
}

load_source configdir.tcl
# from now on Tkabber config directory should be referenced via $::configdir

proc get_snapshot {changelog} {
    set snapshot ""
    if {[catch { open $changelog } fd]} {
	return $snapshot
    }
    while {[gets $fd line] >= 0} {
	if {[regexp {(\d\d\d\d)-(\d\d)-(\d\d)} $line -> year month day]} {
	    set snapshot "-$year$month$day"
	    break
	}
    }
    close $fd
    return $snapshot
}

set tkabber_version "0.11.0"
set toolkit_version "Tcl/Tk [info patchlevel]"

proc rescmd {id res ls} {
    puts "RESULT: $id $res $ls"
}

proc quit {{status 0}} {
    hook::run quit_hook
    catch { bind $::ifacetk::mf <Destroy> {} }
    destroy .
    exit $status
}

namespace eval ifacetk {}
namespace eval ssj {}
load_source hooks.tcl

# Give the starkit a chance to initialize things before
# the bulk of the Tkabber code is loaded:
if {[info commands starkit_init] != ""} starkit_init

hook::add quit_hook logout 10
hook::add quit_hook {
    foreach chan [file channels] {
        if {[string first sock $chan] != -1} {
            catch { close $chan } res
            debugmsg tkabber "closed $chan '$res'"
        }
    }
} 100

load_source default.tcl

hook::add postload_hook postload
hook::add finload_hook finload

if {[info exists env(TKABBER_SITE_CONFIG)] && \
	[file exists $env(TKABBER_SITE_CONFIG)]} {
    source $env(TKABBER_SITE_CONFIG)
}

if {[file exists [file join $configdir config.tcl]]} {
    source [file join $configdir config.tcl]
}

package require BWidget

if {![info exists load_default_xrdb] || $load_default_xrdb} {
    option readfile [fullpath ifacetk default.xrdb] 21

    switch -- $tcl_platform(platform) {
	unix {
	    option readfile [fullpath ifacetk unix.xrdb] 21
	}
    }
}

load_source trans.tcl
::trans::load [file join $rootdir trans]
::msgcat::mcload [file join $rootdir msgs]
foreach pr [::msgcat::mcpreferences] {
    set f [file join $rootdir msgs "$pr.rc"]
    if {[file exists $f]} {
	option read $f
	break
    }
}
foreach pr [::msgcat::mcpreferences] {
    set f [file join $::BWIDGET::LIBRARY "lang" "$pr.rc"]
    if {[file exists $f]} {
	option read $f
	break
    }
}
unset pr f

if {[catch { package require Tclx }]} {
    load_source Tclx.tcl
}

package require jabberlib 0.10.1
load_source xmppmime.tcl

foreach {opt val} $argv {
    switch -- $opt {
	-mime {set mime_file $val}
	-user {set loginconf(user) $val}
	-password {set loginconf(password) $val}
	-resource {set loginconf(resource) $val}
	-port {set loginconf(port) $val}
	-autologin {set autologin $val}
	-chat {xmppmime::send_event [list chat $val]}
	-message {xmppmime::send_event [list message $val]}
	-conference {xmppmime::send_event [list groupchat $val]}
	-splash {set show_splash_window $val}
    }
}

if {[info exists mime_file]} {
    xmppmime::load $mime_file
}
if {[xmppmime::is_done]} exit

load_source splash.tcl

proc ::LOG {text} {
    debugmsg jlib $text
}

proc ::HTTP_LOG {text} {
    debugmsg http $text
}

if {[catch { package require Img }]} {
    debugmsg tkabber \
	"unable to load the Img package, so no PNG/JPEG image support!

The IMG package is available at http://www.xs4all.nl/~nijtmans/img.html"
}

load_source ifacetk idefault.tcl
load_source custom.tcl
load_source utils.tcl
load_source plugins.tcl
load_source pixmaps.tcl
load_source balloon.tcl
load_source presence.tcl
load_source iq.tcl
load_source disco.tcl
load_source roster.tcl
load_source itemedit.tcl
load_source messages.tcl
load_source chats.tcl
load_source joingrdialog.tcl
load_source muc.tcl
load_source login.tcl
load_source userinfo.tcl
load_source datagathering.tcl
load_source negotiate.tcl
load_source mclistbox mclistbox.tcl
load_source search.tcl
load_source register.tcl
load_source si.tcl
load_source filetransfer.tcl
load_source filters.tcl
load_source privacy.tcl
load_source gpgme.tcl
load_source pubsub.tcl
load_source pep.tcl
load_source private.tcl
load_source richtext.tcl

load_source ifacetk bwidget_workarounds.tcl
load_source ifacetk iface.tcl

plugins::load [file join plugins general]
plugins::load [file join plugins roster]
plugins::load [file join plugins search]
plugins::load [file join plugins richtext]
plugins::load [file join plugins pep]
plugins::load [file join plugins $tcl_platform(platform)]
if {[info exists env(TKABBER_SITE_PLUGINS)] && \
	[file isdirectory $env(TKABBER_SITE_PLUGINS)]} {
    plugins::load_dir  $env(TKABBER_SITE_PLUGINS)
}
plugins::load_dir [file join $configdir plugins]

hook::run postload_hook

load_source iface.tcl

hook::run finload_hook

# vim:ts=8:sw=4:sts=4:noet