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
|
# QuickChat Package
#
# Make it easy to access chat room that you frequent.
#
# $Revision: 1.9 $
# Copyright (c) 1998-9 America Online, Inc. All Rights Reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
# Options the user might want to set. A user should use
# set ::TIK(options,...), not the tik_default_set
# The url to refresh chats from
tik_default_set options,quickchat,url http://www.aim.aol.com/tik/aolchats.txt
# All packages must be inside a namespace with the
# same name as the file name.
# Set VERSION and VERSDATE using the CVS tags.
namespace eval quickchat {
regexp -- {[0-9]+\.[0-9]+} {@(#)TiK Quick Chat package $Revision: 1.9 $} \
::quickchat::VERSION
regexp -- { .* } {:$Date: 1999/07/06 13:55:20 $} \
::quickchat::VERSDATE
}
namespace eval quickchat {
variable info
# Must export at least: load, unload, goOnline, goOffline
namespace export load unload goOnline goOffline register
# All packages must have a load routine. This should do most
# of the setup for the package. Called only once.
proc load {} {
menu .quickChatMenu
.toolsMenu add cascade -label [tik_str P_QUICKCHAT_M] -menu .quickChatMenu
.quickChatMenu add command -label [tik_str P_QUICKCHAT_M_NEW] \
-command quickchat::create_newquickchat
.quickChatMenu add command -label [tik_str P_QUICKCHAT_M_REFRESH] \
-command quickchat::download
.quickChatMenu add separator
.quickChatMenu add command -label [tik_str P_QUICKCHAT_M_TT] \
-command [list quickchat::go "TicToc" 4]
.quickChatMenu add command -label [tik_str P_QUICKCHAT_M_L] \
-command [list quickchat::go "Linux" 4]
if {[file exists $::TIK(configDir)/aolchats.txt]} {
# Delay loading until after tikrc by using "after"
after 1000 quickchat::loadChats $::TIK(configDir)/aolchats.txt
}
}
# All pacakges must have goOnline routine. Called when the user signs
# on, or if the user is already online when packages loaded.
proc goOnline {} {
}
# All pacakges must have goOffline routine. Called when the user signs
# off. NOT called when the package is unloaded.
proc goOffline {} {
}
# All packages must have a unload routine. This should remove everything
# the package set up. This is called before load is called when reloading.
proc unload {} {
.toolsMenu delete [tik_str P_QUICKCHAT_M]
destroy .quickChatMenu
destroy .newquickchat
}
# quickchat::register
#
# Arguments:
# title - What to show in the menu
# room - The actual room name
# exchange - The exchange the chat room is in, usually 4 for now.
proc register {title room {exchange 4}} {
set path [split $title {:}]
set lpath [llength $path]
set m .quickChatMenu
foreach p $path {
if {$lpath == 1} {
catch {$m delete $p}
$m add command -label $p \
-command [list quickchat::go $room $exchange]
continue
}
incr lpath -1
set newm "$m.[normalize $p]"
if {![winfo exists $newm]} {
menu $newm
$m add cascade -label $p -menu $newm
}
set m $newm
}
}
proc download {} {
http::geturl $::TIK(options,quickchat,url) \
-headers "Pragma no-cache" -command quickchat::dataAvail
}
proc dataAvail {token} {
upvar #0 $token state
set f [open $::TIK(configDir)/aolchats.txt w]
puts -nonewline $f $state(body)
close $f
loadChats $::TIK(configDir)/aolchats.txt
}
proc loadChats {file} {
set f [open $file r]
while { ![eof $f]} {
set line [gets $f]
foreach {title room exchange} [split $line {;} ] break
quickchat::register $title $room $exchange
}
close $f
}
proc go {room exchange} {
toc_chat_join $::NSCREENNAME $exchange $room
}
proc newquickchat_ok {} {
if {![winfo exists .newquickchat]} {
return
}
quickchat::register $quickchat::info(title) $quickchat::info(room) \
$quickchat::info(exchange)
destroy .newquickchat
}
proc create_newquickchat {} {
set w .newquickchat
if {[winfo exists $w]} {
raise $w
return
}
toplevel $w -class Tik
wm title $w [tik_str P_QUICKCHAT_N_TITLE]
wm iconname $w [tik_str P_QUICKCHAT_N_ICON]
if {$::TIK(options,windowgroup)} {wm group $w .login}
label $w.info -text [tik_str P_QUICKCHAT_N_WARN]
set quickchat::info(title) ""
set quickchat::info(room) ""
set quickchat::info(exchange) "4"
frame $w.titleF
label $w.titleL -text [tik_str P_QUICKCHAT_N_MENU] -anchor se -width 18
entry $w.titleE -text quickchat::info(title)
pack $w.titleL $w.titleE -in $w.titleF -side left
frame $w.roomF
label $w.roomL -text [tik_str P_QUICKCHAT_N_CHAT] -anchor se -width 18
entry $w.roomE -text quickchat::info(room)
pack $w.roomL $w.roomE -in $w.roomF -side left
frame $w.exchangeF
label $w.exchangeL -text [tik_str P_QUICKCHAT_N_EX] -anchor se -width 18
entry $w.exchangeE -text quickchat::info(exchange)
pack $w.exchangeL $w.exchangeE -in $w.exchangeF -side left
frame $w.buttons
button $w.ok -text [tik_str B_OK] -command "quickchat::newquickchat_ok"
button $w.cancel -text [tik_str B_CANCEL] -command [list destroy $w]
pack $w.ok $w.cancel -in $w.buttons -side left -padx 2m
pack $w.info $w.titleF $w.roomF $w.exchangeF -side top
pack $w.buttons -side bottom
}
}
|
